Merge specific sheets by adding the sheet name as the first column

Question

I have quite a number of sheets whose names end in _A or _B. enter image description here

I would like to merge all sheets ending in _A or _B under one another. They have the same number of columns, but different number of rows. However, when merging, I want the sheetname to be repeated all the way down the last row of that sheet in the merged sheet. Result: enter image description here

I want the results to be saved in the same workbook but in a sheet called "merged".
here is the example sheet if you would like to work on.

what I have tried:

Sub Merge_into_One()
    Dim ws As Worksheet
    Dim TargetRow As Long

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False

    TargetRow = 1
    For Each ws In ActiveWorkbook.Sheets
        With ws
            If .Name Like "*" & strSearch & "_A" Or _
              .Name Like "*" & strSearch & "_B" Then
                .Range("A1:C99").Copy
                With Worksheets("Merged").Cells(TargetRow, 1)
                    .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                    End With
                TargetRow = TargetRow + 99
            End If
        End With
    Next ws

    Application.CutCopyMode = False
    Application.ScreenUpdating = True

End Sub

But here, i am taking 99 rows, supposing that my rows will not exceed this number. However, I want to take exactly the same number of rows that appear in each sheet, not more not less. And here I cannot put the name of the sheet in the first column and repeat it until the last hit of the same sheet.

David G David G · Accepted Answer · 2015-06-23T17:35:50

Not tested. EDIT: Oops I forgot a few things it seems.

dim RowsToMerge as integer
dim RowsPresent
dim RangeToMerge as range

For i = 1 To ActiveWorkbook.Worksheets.Count
      If Instr(Worksheets(i).Name, "ABC") <> 0 Then
            Set ws = Worksheets(i)
            RowsToMerge = ws.Cells(Rows.Count, "A").End(xlUp).Row
            RowsPresent = Sheets("Merged").Cells(Rows.Count, "A").End(xlUp).Row
            Set RangeToMerge = ws.Range("A1:C" & RowsToMerge)
            ws.RangeToMerge.Copy destination:=Worksheets("Merged").Range("B" & RowsPresent + 1)
            Worksheets("Merged").Range("A" & RowsPresent + 1) = ws.Name

      End If
Next

Merge specific sheets by adding the sheet name as the first column

1 Answers