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

You want only sheets which contain "A"? You can compare Lens(Sheet.name) to Len(Replace(Sheet.Name,"A","")) and if they are different, use the sheet. — Cyril
– Cyril, Commented Dec 20, 2021 at 14:44

CDP1802 · Accepted Answer · 2021-12-22 12:38:33Z

2

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

edited Dec 22, 2021 at 12:38

answered Dec 20, 2021 at 15:57

CDP1802

17.3k2 gold badges10 silver badges19 bronze badges

Sign up to request clarification or add additional context in comments.

9 Comments

VBasic2008 Over a year ago

To copy only data without headers, B1:B needs to be replaced with B2:B.

user17269242 Over a year ago

Hi, thank you. This one takes the data from only one sheet for some reason.. I understand what it should do but somehow it does not.

CDP1802 Over a year ago

@user1726 Give me an example of a sheet name that it misses.

user17269242 Over a year ago

so the sheets I am using are for account[AC]: AC, AC(1), AC(2),....it creates a new sheet for every test group. Right now it takes only the first test group AC but not the other ones. There are multiple columns of information such as age and gender and an ID number. Many of the information is the same; the age group is often the same. I need a full list of all the separate rows in order to use it later in another program. That's what goes wrong in the other answer, there it does take multiple sheets but it rearranges the information. I tried combining both solutions but that doesn't work yet.

CDP1802 Over a year ago

@user172 You said in the question the names were A, A(2), A(3) etc. If they are AC, AC(1), AC(2) etc change If ws.Name = "A" Or ws.Name Like "A(*)" to If ws.Name = "AC" Or ws.Name Like "AC(*)"

|

VBasic2008 · Accepted Answer · 2021-12-20 16:04:13Z

1

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

answered Dec 20, 2021 at 16:04

VBasic2008

56.8k5 gold badges21 silver badges38 bronze badges

1 Comment

user17269242 Over a year ago

Thank you for helping me, this seems to work partly Right now it does combine the sheets but it also changes the information in the rows. (data from one row now ends up in another row, and the values of the first column are combined if they are the same which makes the other rows start with 0. So I have one sheet with a row containing "18" and "AAC" in the next sheet I also have a row containing "18" and "BBC" this combines to "18" "AAC" and "0" "BBC". While I need it to be "18""AAC" and "18""BBC" I have been trying to figure it out myself but I haven't been able to so far..

Collectives™ on Stack Overflow

Combining data from multiple sheets with variable sheet name

2 Answers 2

9 Comments

Conditionally Copy Entire Rows from Multiple Worksheets

1 Comment

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

9 Comments

Conditionally Copy Entire Rows from Multiple Worksheets

1 Comment

Your Answer

Sign up or log in

Post as a guest

Related