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

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.

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 Replies

HansVogelaar

MVP

Mar 30, 2022

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

alex_n

Brass Contributor

Mar 31, 2022

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

HansVogelaar

MVP

Mar 31, 2022

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

Forum Discussion

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

5 Replies

Resources