VBA - Copy and Paste Range From Multiple Sheets into Summary

mdwmike91

New Member
Joined
Oct 7, 2021
Messages
3
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.
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
18,233
Office Version
  1. 2013
Platform
  1. Windows
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
VBA Code:
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

Well-known Member
Joined
Jul 5, 2014
Messages
18,233
Office Version
  1. 2013
Platform
  1. Windows
Let try this script instead. This will give you a warning if any of the sheet names in the script do not exist.

VBA Code:
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

New Member
Joined
Oct 7, 2021
Messages
3
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
VBA Code:
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

Well-known Member
Joined
Jul 5, 2014
Messages
18,233
Office Version
  1. 2013
Platform
  1. Windows

ADVERTISEMENT

Try this:
VBA Code:
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
 
Solution

mdwmike91

New Member
Joined
Oct 7, 2021
Messages
3
Try this:
VBA Code:
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
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,152,574
Messages
5,770,928
Members
425,652
Latest member
Pemby

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top