Excel VBA code to copy a range of data from certain tabs into summary tab

[alex_n]

Hello everyone!

I have several workbooks (i prepared two WB1 and WB2 for this example but it is over 30 workbooks) that have common tabs like Summary tab and other tabs with tab names that start with "WLD" (it could be WLD - ABC0123, WLD - DEF7845, etc.). I need a universal code that I can use for all workbooks to copy data from the same ranges in "WLD" tabs into a table in Summary tabs in each workbook. All tables in the WLD tabs are on the same range.

Please note that the tab names are not set in stone and they are generated automatically, but the names always start with "WLD".

What I did to get to the end result (that is displayed in each Summary tab of each workbook) is I applied filter in each tab to filter out blanks and copied (copy/paste as values) the data one by one from each tab into the summary tab.

I tried recording macros and modifying them to fit my demands but it would not work for all workbooks and I could not get it to read from the tabs with different names.

Here is the link to my OneDrive where I have posted two example workbooks and also attaching the files in case OneDrive does not function.

https://1drv.ms/u/s!Aqv4zBSFNKaymUVviJkn91U_xY6u?e=i6WuFl

Thanks in advance.

AN.

[#2]

@alex_n 

Here is a macro. It assumes that the Summary sheet already exists, with a header row.

Sub Summarize()
    Dim ws As Worksheet
    Dim wt As Worksheet
    Dim rng As Range
    Application.ScreenUpdating = False
    Set wt = Worksheets("Summary")
    wt.UsedRange.Offset(1).Clear
    For Each ws In Worksheets
        If ws.Name Like "WLD -*" Then
            ws.UsedRange.AutoFilter Field:=1, Criteria1:="<>"
            Set rng = wt.Range("A" & Rows.Count).End(xlUp).Offset(1)
            ws.UsedRange.Offset(1).Copy Destination:=rng
            ws.UsedRange.AutoFilter
        End If
    Next ws
    Application.CutCopyMode = False
    wt.UsedRange.EntireColumn.AutoFit
    Application.ScreenUpdating = True
End Sub

[#3]

Hans, thank you for the help. The code works great! Would you mind modifying your code to accommodate the following: 1) I want only the data from WLDs in range F3:J147 to be copied over to Summary and 2) paste as values only, not the formatting.

Thanks again!
AN

[#4 · Accepted solution]

@alex_n 

Try this version:

Sub Summarize()
    Dim ws As Worksheet
    Dim wt As Worksheet
    Dim rngs As Range
    Dim rngt As Range
    Application.ScreenUpdating = False
    Set wt = Worksheets("Summary")
    wt.UsedRange.Offset(1).Clear
    For Each ws In Worksheets
        If ws.Name Like "WLD -*" Then
            Set rngs = ws.Range("F2:J147")
            rngs.AutoFilter Field:=1, Criteria1:="<>"
            rngs.Offset(1).Copy
            Set rngt = wt.Range("A" & Rows.Count).End(xlUp).Offset(1)
            rngt.PasteSpecial Paste:=xlPasteValues
            rngs.AutoFilter
        End If
    Next ws
    Application.CutCopyMode = False
    wt.UsedRange.EntireColumn.AutoFit
    Application.ScreenUpdating = True
End Sub

[#5]

Hans, it worked! Thank you for your great effort and help!

[#6]

Cannot "Like" for some reason. This worked great for me! Thank you so much! Far more efficient than the other codes I tried and they all failed.