从各种（特定的）工作表汇总到一个工作表

我想在同一个工作簿中完成的工作是将单元格B2中的值复制到多个SELECTED工作表中，并粘贴到名为“Summary”的另一个工作表的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 

Answer 1

我已经对您的第一个代码进行了更改：

  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