VBA - Copy and Paste Range From Multiple Sheets into Summary

[mdwmike91]

Hello,

I am trying to set up a macro that will pull values from a range A123:T215 across multiple worksheets and copy/paste them into a summary page one after another, starting at cell A6. The names and number of worksheets to pull information from will vary from each use, and there are a few additional sheets in the book that I do not want to pull information from.

Any advice on how to set this up would be greatly appreciated.

 

[My Aswer Is This]

Since the sheet names will not always be the same I suggest
1. Create a sheet named "Master"
2. Create a sheet named "Summary"
3. In sheet named "Master" Put the sheet names of the sheets you want to copy data from starting in Range("A2")
So in column A of sheet named Master it would look like this:
A1 "Sheet Names" this is not a sheet name it's just a Header for that column
A2 Alpha
A3 Bravo
A4 Charlie

This is just a sample I'm using sheets named Alpha and Bravo and Charlie in this example
And then when your setup like I mentioned run this script

Sub Copy_Range_From_Sheets()
'Modified  10/7/2021  9:46:39 PM  EDT
Application.ScreenUpdating = False
Dim i As Long
Dim ans As String
Dim Lastrow As Long
Dim Lastrowa As Long
Lastrow = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row
Lastrowa = 6

For i = 2 To Lastrow
    ans = Sheets("Master").Cells(i, 1).Value
    
    With Sheets(ans)
        .Range("A123:T215").Copy Sheets("Summary").Cells(Lastrowa, 1)
        Lastrowa = Sheets("Summary").Cells(Rows.Count, "A").End(xlUp).Row + 1
    End With
Next
Application.ScreenUpdating = True
End Sub

 

[My Aswer Is This]

Let try this script instead. This will give you a warning if any of the sheet names in the script do not exist.

Sub Copy_Range_From_Sheets()
'Modified  10/7/2021  10:01:09 PM  EDT
On Error GoTo M
Application.ScreenUpdating = False
Dim i As Long
Dim ans As String
Dim Lastrow As Long
Dim Lastrowa As Long
Lastrow = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row
Lastrowa = 6

For i = 2 To Lastrow
    ans = Sheets("Master").Cells(i, 1).Value
    
    With Sheets(ans)
        .Range("A123:T215").Copy Sheets("Summary").Cells(Lastrowa, 1)
        Lastrowa = Sheets("Summary").Cells(Rows.Count, "A").End(xlUp).Row + 1
    End With
Next
Application.ScreenUpdating = True
Exit Sub
M:
MsgBox "You tried to use a sheet name that does not exist" & vbNewLine & "Or we had another problem"

Application.ScreenUpdating = True

End Sub

 

[mdwmike91]

Since the sheet names will not always be the same I suggest
1. Create a sheet named "Master"
2. Create a sheet named "Summary"
3. In sheet named "Master" Put the sheet names of the sheets you want to copy data from starting in Range("A2")
So in column A of sheet named Master it would look like this:
A1 "Sheet Names" this is not a sheet name it's just a Header for that column
A2 Alpha
A3 Bravo
A4 Charlie

This is just a sample I'm using sheets named Alpha and Bravo and Charlie in this example
And then when your setup like I mentioned run this script

Sub Copy_Range_From_Sheets()
'Modified  10/7/2021  9:46:39 PM  EDT
Application.ScreenUpdating = False
Dim i As Long
Dim ans As String
Dim Lastrow As Long
Dim Lastrowa As Long
Lastrow = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row
Lastrowa = 6

For i = 2 To Lastrow
    ans = Sheets("Master").Cells(i, 1).Value
   
    With Sheets(ans)
        .Range("A123:T215").Copy Sheets("Summary").Cells(Lastrowa, 1)
        Lastrowa = Sheets("Summary").Cells(Rows.Count, "A").End(xlUp).Row + 1
    End With
Next
Application.ScreenUpdating = True
End Sub

Thank you so much for your help. It looks like it is very close to working. One thing I should have added though is that I would like to copy/paste the values only, and this macro is copying over the formulas. How can I adjust this?

 

[My Aswer Is This]

Try this:

Sub Copy_Range_From_Sheets()
'Modified  10/12/2021  6:36:48 PM  EDT
On Error GoTo M
Application.ScreenUpdating = False
Dim i As Long
Dim ans As String
Dim Lastrow As Long
Dim Lastrowa As Long
Lastrow = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row
Lastrowa = 6

For i = 2 To Lastrow
    ans = Sheets("Master").Cells(i, 1).Value
    
    With Sheets(ans)
        .Range("A123:T215").Copy
        Sheets("Summary").Cells(Lastrowa, 1).PasteSpecial xlPasteValues
        Lastrowa = Sheets("Summary").Cells(Rows.Count, "A").End(xlUp).Row + 1
    End With
Next
Application.ScreenUpdating = True
Exit Sub
M:
MsgBox "You tried to use a sheet name that does not exist" & vbNewLine & "Or we had another problem"
Application.ScreenUpdating = True
End Sub

 

[mdwmike91]

Try this:

Sub Copy_Range_From_Sheets()
'Modified  10/12/2021  6:36:48 PM  EDT
On Error GoTo M
Application.ScreenUpdating = False
Dim i As Long
Dim ans As String
Dim Lastrow As Long
Dim Lastrowa As Long
Lastrow = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row
Lastrowa = 6

For i = 2 To Lastrow
    ans = Sheets("Master").Cells(i, 1).Value
   
    With Sheets(ans)
        .Range("A123:T215").Copy
        Sheets("Summary").Cells(Lastrowa, 1).PasteSpecial xlPasteValues
        Lastrowa = Sheets("Summary").Cells(Rows.Count, "A").End(xlUp).Row + 1
    End With
Next
Application.ScreenUpdating = True
Exit Sub
M:
MsgBox "You tried to use a sheet name that does not exist" & vbNewLine & "Or we had another problem"
Application.ScreenUpdating = True
End Sub

Works like a charm! Thanks for your help

 

[My Aswer Is This]

Works like a charm! Thanks for your help

Glad I was able to help you.
Come back here to Mr. Excel next time you need additional assistance.

 

[SereneSea]

Hello,
I am very new to VBA, and this code works really well, but instead of pasting values I would like links, so the summary sheet gets live updating from whatever is imputed in the other worksheets.
How can I do this?

 

[Fluff]

Hi & welcome to MrExcel.
As your question is totally different from the original request you need to start a thread of your own. Thanks

 

[SereneSea]

Hi & welcome to MrExcel.
As your question is totally different from the original request you need to start a thread of your own. Thanks

Thanks! I just created a new thread