SOLVED

Script to pull data from multiple tabs into new tab

Copper Contributor

Hi. I've never posted before and I'm not sure exactly how to phrase the help I need, so please excuse my wordiness ...

I have a spreadsheet with roughly 600 tabs of all data, each tab is named for a Plan # and contains a house laid out by room, with window measurements, and while the data count in rows varies from tab to tab, all data is contained with the range A2:C54.

My first tab is "1007 A" and contains Column A (Plan Name), Column B (Window Width) and Column C (Window Height), and I created a new tab called "Master" that has Column A (Plan Name), Column B (Window Width) and Column C (Window Height).

And here is where I need help ... how can I pull the data within A2:C54 from all tabs and copy it into the Master tabs Columns A - C, so that all Tab 1 data is in the Master Tab, then all the data from Tab 2, etc.

I hope this is clear enough and I appreciate all the help!

Thanks!

Dominic

2 Replies
best response confirmed by djs72 (Copper Contributor)
Solution

@djs72 

Try this macro. It'll take a while to run with 600 sheets.

Sub Copy2Master()
    Dim ws As Worksheet
    Dim wt As Worksheet
    Dim t As Long
    Application.ScreenUpdating = False
    Set wt = Worksheets("Master")
    For Each ws In Worksheets
        If ws.Name <> "Master" Then
            t = wt.Range("A" & wt.Rows.Count).End(xlUp).Row + 1
            wt.Range("A" & t).Resize(53, 3).Value = ws.Range("A2:C54").Value
        End If
    Next ws
    Application.ScreenUpdating = True
End Sub
Thanks Hans!! It ran quickly and it looks like everything pulled as I wanted, but I'll give it a look through to be sure. I'm pretty good with tweaking existing script so I should be able to make this meet my needs for other projects too. Again, thanks for the help!
1 best response

Accepted Solutions
best response confirmed by djs72 (Copper Contributor)
Solution

@djs72 

Try this macro. It'll take a while to run with 600 sheets.

Sub Copy2Master()
    Dim ws As Worksheet
    Dim wt As Worksheet
    Dim t As Long
    Application.ScreenUpdating = False
    Set wt = Worksheets("Master")
    For Each ws In Worksheets
        If ws.Name <> "Master" Then
            t = wt.Range("A" & wt.Rows.Count).End(xlUp).Row + 1
            wt.Range("A" & t).Resize(53, 3).Value = ws.Range("A2:C54").Value
        End If
    Next ws
    Application.ScreenUpdating = True
End Sub

View solution in original post