Copy Range From Multiple Worksheets to a Single Worksheet

[Dauntless1]

Hello. I am trying to copy a range of cells from multiple worksheets t
an existing worksheet in my workbook. The range is always the same.
When the range is pasted into the single workbook it should keep th
same values and formats and move to the next available row, startin
with the 4th row. Can anyone please help me with the coding for
macro

 

[JLatham]

I wasn't sure if all worksheets involved are in the same workbook or not, the
code below assumes that they are. First routine will copy same range from
all sheets except the master/destination sheet into that master/destination
sheet. The second routine lets you specify a list of sheet names in the
workbook to copy from if you don't want to copy same range from each and
every other sheet in the book.

Sub CopySameRange()
'name of sheet to copy to, change as needed
Const dSheet = "Sheet1"
Dim rngToCopy As Range
Dim copyToRow As Long
Dim anyWS As Worksheet

copyToRow = 4 ' initialize
For Each anyWS In Worksheets
If anyWS.Name <> dSheet Then
'some other sheet, do the copy
'change range address to what you need
Set rngToCopy = anyWS.Range("A510")
rngToCopy.Copy
' I don't think you want formulas, so won't use xlPasteAll
Worksheets(dSheet).Range("A" & copyToRow).PasteSpecial _
xlPasteValues
Worksheets(dSheet).Range("A" & copyToRow).PasteSpecial _
xlPasteFormats
copyToRow = copyToRow + rngToCopy.Rows.Count
End If
Next
Application.CutCopyMode = False
Worksheets(dSheet).Activate
Set rngToCopy = Nothing

End Sub

Sub CopySameRange2()
'name of sheet to copy to, change as needed
Const dSheet = "Sheet1"
Dim rngToCopy As Range
Dim copyToRow As Long
Dim anyWS As Worksheet

copyToRow = 4 ' initialize
'this allows selective copying from just
'specific sheets within the workbook, not All others
For Each anyWS In Worksheets
Select Case anyWS.Name
Case "Sheet2", "Sheet4", "sheet 15", _
"sheet 29"
Set rngToCopy = anyWS.Range("A510")
rngToCopy.Copy
' I don't think you want formulas, so won't use xlPasteAll
Worksheets(dSheet).Range("A" & copyToRow).PasteSpecial _
xlPasteValues
Worksheets(dSheet).Range("A" & copyToRow).PasteSpecial _
xlPasteFormats
copyToRow = copyToRow + rngToCopy.Rows.Count
Case Else
'do nothing
End Select
Next
Application.CutCopyMode = False
Worksheets(dSheet).Activate
Set rngToCopy = Nothing

End Sub

 

[Dauntless1]

Thank you for the assistance. I tried the code for the 2nd routine
since I had a select group of worksheets from which I wanted to copy.
However, I did encounter an issue at the point with the line with the
PasteSpecial. I received an error message for that line stating:
Application-defined or Object-defined error.
Can you help me please?

 

[JLatham]

Make sure you copied it accurately and that what is in your workbook looks
exactly like what I posted. You might even copy your code and paste here so
we can see what might have gotten messed up.

The lines that have .PasteSpecial near the end of them are actually
continued on the next line in the code. The " _" (space followed by
underscore) at the very end tells Excel that the statement is continued on
the next line.

When you get the error, what is on the line following the indicated error
line? xlPasteValues or xlPasteFormats?

Double check the spelling of your worksheet names in the Case statement, and
of course the address used in the Set rngToCopy statement.

 

[Dauntless1]

I went back and looked at the code. I think I made some minor errors.
I corrected them and tweaked the code a bit...I also had som
formatting issues on the end worksheet that I had to fix, so now i
runs extremely well!

Thank you for your time and assistance! It is greatly appreciated.

Make sure you copied it accurately and that what is in your workboo
looks
exactly like what I posted. You might even copy your code and past
here so
we can see what might have gotten messed up.

The lines that have .PasteSpecial near the end of them are actually
continued on the next line in the code. The " _" (space followed by
underscore) at the very end tells Excel that the statement is continue
on
the next line.

When you get the error, what is on the line following the indicate
error
line? xlPasteValues or xlPasteFormats?

Double check the spelling of your worksheet names in the Cas
statement, and
of course the address used in the Set rngToCopy statement.


:
-

 

[JLatham]

Very glad to hear that. And that things are working as you need now. Thanks
for letting me know that it works properly now.