使用VBA代碼根據某些條件將工作表合並為一個

Question

在一個工作簿中，有數百個工作表。 我正在嘗試將某些工作表（其名稱以“ _A”或“ _B”結尾）中的某個范圍（A2：D6）合並到一個工作表（“組合”）中。
目標工作表的數據結構相同：

目標工作表名稱均以“ _A”或“ _B”結尾：例如
代碼1_A
代碼1_B
代碼2_A
代碼2_B
代碼3_A
代碼3_B
。
。
。

我想像這樣將它們粘貼為VALUE並保留FORMAT ：

目前，我有以下代碼：

Sub Merge ()
Dim Sheet As Worksheet
For Each Sheet In ActiveWorkbook.Sheets
    If Sheet.Name Like "*" & strSearch & "_A" Or _
       Sheet.Name Like "*" & strSearch & "_B" Then
         Sheets(Sheet.Name).Range("A2:D6").Copy
    End If
Next

With Worksheets("Combined").Range("A2")
          .PasteSpecial Paste:=xlPasteValues
          .PasteSpecial Paste:=xlPasteFormats
End With


End Sub

*問題 ：我的代碼查找以“ _A”和“ _B”結尾的工作表，但是覆蓋了它們或獲取了匹配的第一個實例。 如何解決它以獲取所有以“ _A”或“ _B”結尾的工作表並循環直到所有目標工作表中的所有范圍被一個合並在另一個之下？

還是有其他方法可以更快地實現這一目標？

Answer 1

注意更新IF語句和移動With部分

Sub Merge ()
Dim Sheet As Worksheet

For Each Sheet In ActiveWorkbook.Sheets
'Note the change on this line:
  If Sheet.Name Like "*" & strSearch & "_A" or _
     Sheet.Name Like "*" & strSearch & "_B" Then
     Sheets(Sheet.Name).Range("A2:D6").Copy

    With Worksheets("Combined").Range("A2")
      .PasteSpecial Paste:=xlPasteValues
      .PasteSpecial Paste:=xlPasteFormats
    End With
  End If
Next

End Sub

Answer 2

首先，您必須將粘貼操作移入循環。 其次，粘貼復制的值的行需要增加，否則將一次又一次覆蓋相同的區域：

    Sub Merge ()
   Dim Sheet As Worksheet
   Dim TargetRow as long


   Application.Calculation = xlCalculationManual
   Application.ScreenUpdating = False

   TargetRow = 1
   For Each Sheet In ActiveWorkbook.Sheets
      If Sheet.Name Like "*" & strSearch & "_?" Then
         Sheets(Sheet.Name).Range("A2:D6").Copy
         With Worksheets("Combined").Cells(TargetRow,1)
            .PasteSpecial Paste:=xlPasteValues
            .PasteSpecial Paste:=xlPasteFormats
         End With
         TargetRow = TargetRow + 5
      End If
   Next
   Application.CutCopyMode = False
   Application.ScreenUpdating = True
   Application.Calculation = xlCalculationAutomatic
End Sub

我添加了通常的優化措施，以暫時禁用屏幕更新和重新計算。 無論如何，復制和粘貼將花費很長時間，需要100張紙。 有更快的方法（超出此級別的VBA），但是這種方法可以工作。

編輯 ：我用一個簡單的'？' 覆蓋工作表名稱中的任何單個字母。 如果對於您的情況而言太寬泛，則使用和'或'IF語句，如FreeMan建議的那樣。
編輯 ：它是Application.Calculation不是Application.Calculationstate ，已更正。