Consolidation several tabs' data into a consolidation sheet via a loop?

Hi all,

I was hoping someone could help me with some loop code for below consolidation macro.

My workbook has a "Consolidation" tab and several country tabs (all same format). My code consolidates all of the individual country tabs (after a filter is applied), one below the other in the consolidation tab.

Below code works for 2 countries but there will be 20+ country tabs.

I'm hoping someone can tweak my code so it can loop through all the country tabs rather than having to duplicate the code over and over like below.

Sub Consolidate()
      
Set CONS = Sheets("Consolidation")
Set DEN = Sheets("Denmark")
Set SPA = Sheets("Spain")
            

'Denmark
LR = DEN.Range("B" & Rows.Count).End(xlUp).Row
DEN.Range("B9:CQ" & LR).AutoFilter Field:=94, Criteria1:="Data"

LR = DEN.Range("B" & Rows.Count).End(xlUp).Row
DEN.Range("B10:CQ" & LR).Copy
CONS.Range("A2").PasteSpecial xlPasteValues

'Spain
LR = SPA.Range("B" & Rows.Count).End(xlUp).Row
SPA.Range("B9:CQ" & LR).AutoFilter Field:=94, Criteria1:="Data"

LR = SPA.Range("B" & Rows.Count).End(xlUp).Row
SPA.Range("B10:CQ" & LR).Copy
LR = CONS.Range("B" & Rows.Count).End(xlUp).Row
CONS.Range("A" & LR + 1).PasteSpecial xlPasteValues
     
End Sub

How does this work for you?

EDIT: Added a "Select Case" statement so you can add the names of the tabs you want to copy in case there are more tabs than just country tabs. This also makes sure the "Consolidation" tab is not included (if your name's not down, you're not coming in!)

Sub Consolidate()
     
    Dim wSheet As Worksheet
    Dim Cons As Worksheet
    Dim PasteRow As Long
    Dim LR As Long
     
    Set Cons = Sheets("Consolidation")
                
    For Each wSheet In ThisWorkbook.Sheets
        Select Case wSheet.Name
            Case "Denmark", "Spain", "Another country", "Yet another country"
                LR = wSheet.Range("B" & Rows.Count).End(xlUp).Row
                wSheet.Range("B9:CQ" & LR).AutoFilter Field:=94, Criteria1:="Data"
                wSheet.Range("B10:CQ" & LR).Copy
                PasteRow = Cons.Range("a" & Cons.Rows.Count).End(xlUp).Row + 1
                Cons.Range("A" & PasteRow).PasteSpecial xlPasteValues
        End Select
    Next
     
End Sub

I seem to remember something about having to activate a sheet before the filter works properly when looping through sheets. Just insert

wSheet.Activate

into the line above where LR is calculated, within the case in my code see if that works.

Also, the code you pasted back is still working on DEN instead of wSheet.

Originally Posted by Gti182

thanks kadeo and John both work great!

A pleasure!