Forum Discussion

Brass Contributor

Mar 30, 2022

Solved

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 ...

Mar 31, 2022

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

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

mwolf222
Copper Contributor
Oct 24, 2023
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.
alex_n
Brass Contributor
Mar 31, 2022
Hans, it worked! Thank you for your great effort and help!