從工作簿中的工作表子集中複製數據並粘貼到主工作表，忽略標準主表

Question

對社區致以衷心的感謝，並提前感謝您的幫助。我創建了一個工作簿，其中有大量可變名稱的工作表。然而，有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 

Answer 1

不幸的是，這條線將不適合你：

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

的Disreguard變量是一個陣列，但在VBA不是一個對象，所以有沒有方法可以使用點運算符訪問。你將不得不遍歷數組的內容，並根據你正在測試的字符串檢查每個項目。

可以添加功能，以測試它是這樣的：

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 

然後傳遞數組與片材名稱一起測試像這樣：

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

此外，LASTROW（）函數沒有從你發佈的內容中定義。這是你創建的功能嗎？

實際上，您可以自己記錄最後一行，因爲每次運行此操作時都要重新生成「RDBMergeSheet」工作表。您可以從設置Last = 1開始，然後一路增加。還有最後一件事情，你應該測試一下，看看每行中是否有第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