从工作簿中的工作表子集中复制数据并粘贴到主工作表,忽略标准主表

你好,社区,并提前感谢您的帮助。 我已经创build了一个工作簿,其中有大量可变名称的工作表。 然而,有4个工作表不会改变,我不希望从它们复制数据。 我正在尝试的代码如下:如果我的基地,请让我知道。

V / R道格

Private Sub GroupReport_Click() Dim sh As Worksheet Dim DestSh As Worksheet Dim Last As Long Dim CopyRng As Range Dim Disreguard(1 To 4) As String Disreguard(1) = "RDBMergeSheet" Disreguard(2) = "0 Lists" Disreguard(3) = "0 MasterCrewSheet" Disreguard(4) = "00 Overview" ' Delete the summary sheet if it exists. Application.DisplayAlerts = False On Error Resume Next ActiveWorkbook.Worksheets("RDBMergeSheet").Delete On Error GoTo 0 Application.DisplayAlerts = True ' Add a new summary worksheet. Set DestSh = ActiveWorkbook.Worksheets.Add DestSh.Name = "RDBMergeSheet" ' Loop through all worksheets and copy the data to the ' summary worksheet. For Each sh In ActiveWorkbook.Worksheets If sh.Name <> Disreguard.Worksheets.Name Then Last = LastRow(DestSh) Set CopyRng = sh.Rows("21") CopyRng.Copy With DestSh.Cells(Last + 1, "A") .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False End With End If Next 

不幸的是,这条线不适合你:

 If sh.Name <> Disreguard.Worksheets.Name Then 

Disreguardvariables是一个数组,但不是VBA中的对象,所以没有方法可以使用点运算符访问。 你将不得不遍历数组的内容,并检查每个项目对你正在testing的string。

你可以添加一个函数来testing它,像这样:

 Private Function toDisreguard(ByRef list() as String, ByRef searchString As String) As Boolean Dim i As Long For i = LBound(list) To UBound(list) If (searchString = list(i)) Then toDisreguard = True Exit Function End If Next i toDisreguard = False End Function 

然后将数组和表名一起传递来testing,如下所示:

 If (toDisreguard(Disreguard, sh.Name) = False) Then 

此外,LastRow()函数不是从您发布的内容定义的。 这是你创build的function吗?

事实上,你可以自己logging最后一行,因为每次运行这个时都要重build“RDBMergeSheet”工作表。 您可以从设置Last = 1开始,然后一路增加。 还有最后一件事情,你可能应该testing一下,看看每行中是否有第21行的数据,这样就不会复制空行。

 ' Loop through all worksheets and copy the data to the ' summary worksheet. Last = 1 For Each sh In ActiveWorkbook.Worksheets If (toDisreguard(Disreguard, sh.Name) = False) Then 'Last = LastRow(DestSh) If (Application.WorksheetFunction.CountA(sh.Rows("21")) > 0) Then Set CopyRng = sh.Rows("21") CopyRng.Copy With DestSh.Cells(Last, "A") ' notice i changed this as well .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False End With Last = Last + 1 End If End If Next