merge worksheets into one based on certain criteria using VBA code

Question

In one workbook, there are some hundred worksheets. I am trying to merge a certain range (A2:D6) from certain worksheets (whose name end in "_A" or "_B") into one worksheet ("combined").
The data structure is the same across the target sheets:
enter image description here

the target sheet names all end in "_A" or "_B" : for example
Code1_A
Code1_B
Code2_A
Code2_B
Code3_A
Code3_B
.
.
.

I want to combine them like this PASTING as VALUE and keeping the FORMAT:

enter image description here

At the moment, I have the following code:

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

*Problem: my code looks for sheets ending in "_A" and "_B", but either overwrites them or gets the first instance of the match. How to fix it to get ALL sheets ending in "_A" or "_B" and to loop until all the ranges from all the target sheets are combined one under the other?

Or is there any other way to achieve this faster?

user1016274 user1016274 · Accepted Answer · 2015-04-03T17:58:22

First, you have to move the paste operation into the loop. Second the row into which you paste the copied values needs to be incremented or else you will overwrite the same area again and again:

    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

I've added the usual optimizations to temporarily disable screen updating and recalculations. Copying and pasting will take a long time anyway, with 100s of sheets. There are faster ways (beyond this level of VBA) but this one will work.

Edit: I've used a simple '?' to cover any single letter in the sheet's name. If that is too broad for your case then use and 'or'ed IF statement like FreeMan suggests.
edit: it's Application.Calculation not Application.Calculationstate, corrected.

merge worksheets into one based on certain criteria using VBA code

2 Answers