резюме из различных (конкретных) рабочих листов на один рабочий лист

Все, что я хочу сделать в той же книге, это скопировать значение из ячейки B2 в несколько таблиц SELECTED и вставить в столбец D в другой рабочий лист под названием «Сводка». Кроме того, я хотел бы также скопировать и вставить соответствующее имя рабочего листа в столбце C. Это два кода, которые у меня до сих пор, оба не удалось, не знаю, как их исправить, не уверен, есть ли лучший способ сделать это , Я новичок в VBA. Я уверен, вы найдете глупые ошибки, пожалуйста, простите меня. Оба кода выходят из строя под «Ошибка времени выполнения» 5: Недопустимый вызов или аргумент процедуры ». Любая помощь высоко ценится.

Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function Function LastCol(sh As Worksheet) On Error Resume Next LastCol = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByColumns, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Column On Error GoTo 0 End Function Sub CopyRangeFromMultiWorksheets() Dim sh As Worksheet Dim wb As Workbook Dim DestSh As Worksheet With Application .ScreenUpdating = False .EnableEvents = False End With Set wb = ThisWorkbook Set DestSh = wb.Sheets("Summary") ' Loop through worksheets that start with the name "20" ' This section I tested and it works For Each sh In ActiveWorkbook.Worksheets If LCase(Left(sh.Name, 2)) = "20" Then ' Specify the range to copy the data ' This portion has also been tested and it works sh.Range("B2").Copy ' Paste copied range into "Summary" worksheet in Column D ' This is the part that does not work I get: ' Run-time error '5' : Invalid procedure call or argument With DestSh.Cells("D2:D") .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False End With ' This statement will copy the sheet names in the C column. ' I have not been able to check this part since I am stock in the previous step DestSh.Cells("C2:C").Resize(CopyRng.Rows.Count).Value = sh.Name End If Next ExitTheSub: Application.Goto Worksheets("Summary").Cells(1) With Application .ScreenUpdating = True .EnableEvents = True End With End Sub 

Второй код:

 Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function Function LastCol(sh As Worksheet) On Error Resume Next LastCol = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByColumns, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Column On Error GoTo 0 End Function Sub CopyRangeFromMultiWorksheets() Dim sh As Worksheet With Application .ScreenUpdating = False .EnableEvents = False End With ' Loop through worksheets that start with the name "20" ' This section I tested and it works For Each sh In ActiveWorkbook.Worksheets If LCase(Left(sh.Name, 2)) = "20" Then ' Specify the range to copy the data ' This portion has also been tested and it works sh.Range("B2").Copy ' Paste copied range into "Summary" worksheet in Column D ' This is the part that does not work I get: ' Run-time error '5' : Invalid procedure call or argument Worksheets("Summary").Cells("D2:D").PasteSpecial (xlPasteValues) ' This statement will copy the sheet names in the C column. ' I have not been able to check this part works since I am stock in the previous step Worksheets("Summary").Cells("C2:C").Resize(CopyRng.Rows.Count).Value = sh.Name End If Next ExitTheSub: Application.Goto Worksheets("Summary").Cells(1) With Application .ScreenUpdating = True .EnableEvents = True End With End Sub 

Я внес изменения в свой первый код:

  Sub CopyRangeFromMultiWorksheets() Dim sh As Worksheet Dim wb As Workbook Dim DestSh As Worksheet Dim LastRow As Long With Application .ScreenUpdating = False .EnableEvents = False End With Set wb = ThisWorkbook Set DestSh = wb.Sheets("Summary") ' Loop through worksheets that start with the name "20" ' This section I tested and it works For Each sh In ActiveWorkbook.Worksheets If LCase(Left(sh.Name, 2)) = "20" Then ' Specify the range to copy the data ' This portion has also been tested and it works sh.Range("B2").Copy LastRow = DestSh.Cells(Rows.Count, "D").End(xlUp).Row + 1 'find the last row of column "D" ' Paste copied range into "Summary" worksheet in Column D ' This is the part that does not work I get: ' Run-time error '5' : Invalid procedure call or argument 'With DestSh.Cells("D2:D") ----> this line is giving error With DestSh.Cells(LastRow, 4) '----> 4 is for Column "D" .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False End With ' This statement will copy the sheet names in the C column. ' I have not been able to check this part since I am stock in the previous step LastRow = DestSh.Cells(Rows.Count, "C").End(xlUp).Row + 1 'find the last row of column "C" 'DestSh.Cells("C2:C").Resize(CopyRng.Rows.Count).Value = sh.Name ----> this line is giving error DestSh.Cells(LastRow, 3).Value = sh.Name '----> 3 is for Column "C" End If Next ExitTheSub: Application.Goto Worksheets("Summary").Cells(1) With Application .ScreenUpdating = True .EnableEvents = True End With End Sub 
Давайте будем гением компьютера.