# How to copy same range from multiple worksheets and paste into a new worksheet.

### Question

• my workbook contains more than 40 worksheets and i need copy the same range from each of

these worksheet into a new worksheet in the same columns.

can anybody help me solving this problem, thanks a million.

Tuesday, April 26, 2011 3:16 AM

• my workbook contains more than 40 worksheets and i need copy the same range from each of

these worksheet into a new worksheet in the same columns.

can anybody help me solving this problem, thanks a million.

1. Create a new sheet and rename: Archive
2. Copy/paste the maco below in a standard module(ALT+F11, Insert-->Module)
3. ALT+F11
4. ALT+F8
5. Select: m()
6. Run

Public Sub m()
Dim lRow As Long
Dim sh As Worksheet
Dim shArc As Worksheet
Set shArc = ThisWorkbook.Worksheets("Archive")
For Each sh In ThisWorkbook.Worksheets
Select Case sh.Name
Case Is <> "Archive"
lRow = shArc.Range("A" & Rows.Count).End(xlUp).Row
sh.Range("A1:A100").Copy _
destination:=shArc.Range("A" & lRow)
End Select
Next
Set shArc = Nothing
Set sh = Nothing
End Sub

In this example is the Range("A1:A100") copied from several sheets other then Archive and pasted into column A of sheet Archive

http://www.maurogsc.eu/

Tuesday, April 26, 2011 12:11 PM

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm

"Mauro Gamberini" wrote in message news:9d373a37-843c-472a-8697-2466e0479f5d...

my workbook contains more than 40 worksheets and i need copy the same range from each of

these worksheet into a new worksheet in the same columns.

can anybody help me solving this problem, thanks a million.

1. Create a new sheet and rename: Archive
2. Copy/paste the maco below in a standard module(ALT+F11, Insert-->Module)
3. ALT+F11
4. ALT+F8
5. Select: m()
6. Run

Public Sub m()
Dim lRow As Long
Dim sh As Worksheet
Dim shArc As Worksheet
Set shArc = ThisWorkbook.Worksheets("Archive")
For Each sh In ThisWorkbook.Worksheets
Select Case sh.Name
Case Is <> "Archive"
lRow = shArc.Range("A" & Rows.Count).End(xlUp).Row
sh.Range("A1:A100").Copy _
destination:=shArc.Range("A" & lRow)
End Select
Next
Set shArc = Nothing
Set sh = Nothing
End Sub

In this example is the Range("A1:A100") copied from several sheets other then Archive and pasted into column A of sheet Archive

http://www.maurogsc.eu/

Tuesday, April 26, 2011 4:59 PM
•

Thanks, you really helped.

My range has three colums actually, and i just changed the Range as Range(A10:C60), the macro still worked, do i need some other

changes to the marco to make it more robust?

And if i want to use PasteSpecial, could you give me more tips?  Thanks.

Try:

Public Sub m()
Dim lRow As Long
Dim sh As Worksheet
Dim shArc As Worksheet
Set shArc = ThisWorkbook.Worksheets("Archive")
For Each sh In ThisWorkbook.Worksheets
Select Case sh.Name
Case Is <> "Archive"
lRow = shArc.Range("A" & Rows.Count).End(xlUp).Row+1
sh.Range("A1:C60").Copy
shArc.Range("A" & lRow).PasteSpecial
End Select
Next
Application.CutCopyMode = False
Set shArc = Nothing
Set sh = Nothing
End Sub

http://www.maurogsc.eu/
• Marked as answer by Thursday, April 28, 2011 3:20 AM
Wednesday, April 27, 2011 8:23 AM

### All replies

• my workbook contains more than 40 worksheets and i need copy the same range from each of

these worksheet into a new worksheet in the same columns.

can anybody help me solving this problem, thanks a million.

1. Create a new sheet and rename: Archive
2. Copy/paste the maco below in a standard module(ALT+F11, Insert-->Module)
3. ALT+F11
4. ALT+F8
5. Select: m()
6. Run

Public Sub m()
Dim lRow As Long
Dim sh As Worksheet
Dim shArc As Worksheet
Set shArc = ThisWorkbook.Worksheets("Archive")
For Each sh In ThisWorkbook.Worksheets
Select Case sh.Name
Case Is <> "Archive"
lRow = shArc.Range("A" & Rows.Count).End(xlUp).Row
sh.Range("A1:A100").Copy _
destination:=shArc.Range("A" & lRow)
End Select
Next
Set shArc = Nothing
Set sh = Nothing
End Sub

In this example is the Range("A1:A100") copied from several sheets other then Archive and pasted into column A of sheet Archive

http://www.maurogsc.eu/

Tuesday, April 26, 2011 12:11 PM

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm

"Mauro Gamberini" wrote in message news:9d373a37-843c-472a-8697-2466e0479f5d...

my workbook contains more than 40 worksheets and i need copy the same range from each of

these worksheet into a new worksheet in the same columns.

can anybody help me solving this problem, thanks a million.

1. Create a new sheet and rename: Archive
2. Copy/paste the maco below in a standard module(ALT+F11, Insert-->Module)
3. ALT+F11
4. ALT+F8
5. Select: m()
6. Run

Public Sub m()
Dim lRow As Long
Dim sh As Worksheet
Dim shArc As Worksheet
Set shArc = ThisWorkbook.Worksheets("Archive")
For Each sh In ThisWorkbook.Worksheets
Select Case sh.Name
Case Is <> "Archive"
lRow = shArc.Range("A" & Rows.Count).End(xlUp).Row
sh.Range("A1:A100").Copy _
destination:=shArc.Range("A" & lRow)
End Select
Next
Set shArc = Nothing
Set sh = Nothing
End Sub

In this example is the Range("A1:A100") copied from several sheets other then Archive and pasted into column A of sheet Archive

http://www.maurogsc.eu/

Tuesday, April 26, 2011 4:59 PM
•

Thanks, you really helped.

My range has three colums actually, and i just changed the Range as Range(A10:C60), the macro still worked, do i need some other

changes to the marco to make it more robust?

And if i want to use PasteSpecial, could you give me more tips?  Thanks.

1. Create a new sheet and rename: Archive
2. Copy/paste the maco below in a standard module(ALT+F11, Insert-->Module)
3. ALT+F11
4. ALT+F8
5. Select: m()
6. Run

Public Sub m()
Dim lRow As Long
Dim sh As Worksheet
Dim shArc As Worksheet
Set shArc = ThisWorkbook.Worksheets("Archive")
For Each sh In ThisWorkbook.Worksheets
Select Case sh.Name
Case Is <> "Archive"
lRow = shArc.Range("A" & Rows.Count).End(xlUp).Row
sh.Range("A1:A100").Copy _
destination:=shArc.Range("A" & lRow)
End Select
Next
Set shArc = Nothing
Set sh = Nothing
End Sub

In this example is the Range("A1:A100") copied from several sheets other then Archive and pasted into column A of sheet Archive

http://www.maurogsc.eu/

Wednesday, April 27, 2011 2:19 AM
• Hi, thanks. I visit your website, your solution is really great and your website contains so many useful tips which help me a lot.
Thanks again for your kind help.

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm

Wednesday, April 27, 2011 2:43 AM
•

Thanks, you really helped.

My range has three colums actually, and i just changed the Range as Range(A10:C60), the macro still worked, do i need some other

changes to the marco to make it more robust?

And if i want to use PasteSpecial, could you give me more tips?  Thanks.

Try:

Public Sub m()
Dim lRow As Long
Dim sh As Worksheet
Dim shArc As Worksheet
Set shArc = ThisWorkbook.Worksheets("Archive")
For Each sh In ThisWorkbook.Worksheets
Select Case sh.Name
Case Is <> "Archive"
lRow = shArc.Range("A" & Rows.Count).End(xlUp).Row+1
sh.Range("A1:C60").Copy
shArc.Range("A" & lRow).PasteSpecial
End Select
Next
Application.CutCopyMode = False
Set shArc = Nothing
Set sh = Nothing
End Sub