使用 VBA 代码根据特定条件将工作表合并为一个

Question

一本作业本，有上百个作业sheet。我正在尝试将某些作品sheet（其名称以“_A”或“_B”结尾）中的某个范围（A2:D6）合并为一个作品sheet（"combined"） .
整个目标 sheets:
的数据结构相同

目标 sheet 名称都以“_A”或“_B”结尾：例如
Code1_A
Code1_B
Code2_A
Code2_B
Code3_A
Code3_B
.
.
.

我想像这样将它们组合起来 PASTING 为 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”结尾的 sheets，但要么覆盖它们，要么获取匹配项的第一个实例. 如何修复它以获取所有以“_A”或“_B”结尾的 sheet 并循环直到所有目标 sheet 的所有范围都是合二为一?

或者有没有其他方法可以更快地实现这一点？

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

我添加了常规优化以暂时禁用屏幕更新和重新计算。反正复制粘贴要花很长时间，100s sheets。有更快的方法（超出 VBA 这一级别），但这个方法可行。

编辑：我用了一个简单的'?'覆盖 sheet 名称中的任何单个字母。如果这对你的情况来说太宽泛，那么使用和'或'运算的 IF 语句就像 FreeMan 建议的那样。
编辑：它是Application.Calculation而不是Application.Calculationstate，已更正。

使用 VBA 代码根据特定条件将工作表合并为一个

merge worksheets into one based on certain criteria using VBA code

excel

vba

while-loop