Combining data from multiple sheets with variable sheet name

Question

I want to combine data from multiple sheets. The sheets all have the same autogenerated name: A, A(2), A(3) etc. I can select the data and paste it in the combined sheet for the first sheet (A) but I cannot get it to work for any of the following sheets. The Issue is that I cannot use <> "combined" because there are other sheets (B,C & D) from which I do not need/want the data. Nor can I just name all the sheets because the number of sheets A(#) is variable too so I get an error when I try. So far this is the part that works:

Sheets("A").Select

Dim rgSelect As Range, c As Range
 For Each c In ActiveSheet.Range("B:B")
 If Not c = 0 Then
 If rgSelect Is Nothing Then Set rgSelect = c
 Set rgSelect = Union(rgSelect, c)
 
 End If
 Next c
 rgSelect.EntireRow.Copy Destination:=Sheets("Combined").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)

 
 Sheets("Combined").Select

Do you perhaps know a solution? I was reading about INDIRECT function but so far I haven't been able to get that to work

Answer 1

Use the comparison operator Like

Opton Explicit
Sub combine()

    Const COPY_COLS = 22 ' B to W

    Dim wb As Workbook, ws As Worksheet, wsCmb As Worksheet
    Dim rngCmb As Range, rngSelect As Range, c As Range
    Dim lastrow As Long, i As Long, n As Long, msg As String
    Dim t0 As Single: t0 = Timer
    
    Set wb = ThisWorkbook
    Set wsCmb = wb.Sheets("Combined")
    With wsCmb
        lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
        Set rngCmb = .Cells(lastrow + 1, "B")
    End With
    
    Application.ScreenUpdating = False
    For Each ws In wb.Sheets
        If ws.Name = "AC" Or Trim(ws.Name) Like "AC (*)" Then
            
            Set rngSelect = Nothing
            n = 0
            With ws
               lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
               ' select rows
               For Each c In .Range("B1:B" & lastrow)
                    If c <> 0 Then
                        If rngSelect Is Nothing Then Set rngSelect = c.Resize(1, COPY_COLS)
                        Set rngSelect = Union(rngSelect, c.Resize(1, COPY_COLS))
                        n = n + 1
                    End If
               Next
               
               ' copy to combined
               If n > 0 Then
                   rngSelect.Copy
                   rngCmb.PasteSpecial xlPasteValues
                   Set rngCmb = rngCmb.Offset(n)
                   Application.CutCopyMode = False
               End If
               msg = msg & vbLf & n & " rows from " & ws.Name
            End With
        Else
            Debug.Print "Skipped '" & ws.Name & "'"
        End If
    Next
    wsCmb.Select
    Application.ScreenUpdating = True
    MsgBox "Sheets combined " & msg, vbInformation, Format(Timer - t0, "0.0 secs")

End Sub

Answer 2

Conditionally Copy Entire Rows from Multiple Worksheets

Option Explicit

Sub CombineData()
    ' Source
    Const sBaseName As String = "A"
    Const sCol As String = "B"
    Const sfRow As Long = 2
    ' Destination
    Const dName As String = "Combined"
    Const dfCellAddress As String = "A2"
    ' Workbook
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Destination
    Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
    Dim dfCell As Range: Set dfCell = dws.Range(dfCellAddress)
    ' Clear previous data.
    Dim ddrg As Range
    Set ddrg = dfCell.Rows(1).Resize(dws.Rows.Count - dfCell.Row + 1)
    ddrg.Clear
    
    Dim sws As Worksheet
    Dim srg As Range
    Dim surg As Range
    Dim sCell As Range
    Dim slRow As Long
    
    For Each sws In wb.Worksheets
        ' When the worksheets start with 'sBaseName'. Improve if necessary.
        If InStr(1, sws.Name, sBaseName, vbTextCompare) = 1 Then
            slRow = sws.Cells(sws.Rows.Count, sCol).End(xlUp).Row
            If slRow >= sfRow Then
                Set srg = sws.Range(sws.Cells(sfRow, sCol), _
                    sws.Cells(slRow, sCol))
                For Each sCell In srg.Cells
                    If sCell.Value <> 0 Then
                        If surg Is Nothing Then ' first cell
                            Set surg = sCell
                        Else ' combine cells
                            Set surg = Union(surg, sCell)
                        End If
                    'Else ' cell value is 0
                    End If
                Next sCell
                 ' 'Union' works only on one worksheet.
                If Not surg Is Nothing Then
                    surg.EntireRow.Copy Destination:=dfCell
                    Set dfCell = dfCell.Offset(surg.Cells.Count)
                    Set surg = Nothing
                'Else ' no cell found
                End If
            'Else ' no data in worksheet
            End If
        'Else ' wrong worksheet
        End If
    Next sws
    
    MsgBox "Data combined.", vbInformation
    
End Sub