PDA

View Full Version : Runtime error 1004 - paste method of worksheet class failed



mb314
09-25-2014, 11:00 AM
Hello,
I am attempting to run the following macro, but I received a runtime error 1004 (paste method of worksheet class failed). This happens on the last ActiveSheet.Paste command. Could any of you point me in the right direction?
Thanks



Sub Combine()

Worksheets("SourceSheet1").Activate

Range("A2").Select
Selection.CurrentRegion.Select
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
Selection.Copy
Worksheets("DestinationSheet").Activate
Range("A2").Select
ActiveSheet.Paste

Worksheets("SourceSheet2").Activate
Range("A2").Select
Selection.CurrentRegion.Select
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
Selection.Copy Destination:=Worksheets("DestinationSheet").Range("A65536").End(xlUp)(2)

Worksheets("DestinationSheet").Activate
ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1).EntireRow.Select
ActiveSheet.Paste

End Sub

mancubus
09-25-2014, 11:35 AM
welcome to the forum.

before "paste", you should "copy" something. and the last bit in the code omits a copy statenebt.

i assume you want to exclude the header rows by Selection.Offset(1, 0) and paste the headers with the last bit.

try something like



Sub Combine()

Worksheets("SourceSheet1").Range("A1").CurrentRegion.Offset(1).Copy Worksheets("DestinationSheet").Range("A2")
Worksheets("SourceSheet2").Range("A1").CurrentRegion.Offset(1).Copy Worksheets("DestinationSheet").Range("A65536").End(xlUp)(2)
Worksheets("SourceSheet1").Range("A1").CurrentRegion.Rows(1).Copy Worksheets("DestinationSheet").Range("A1")

End Sub

mb314
09-25-2014, 11:48 AM
welcome to the forum.

before "paste", you should "copy" something. and the last bit in the code omits a copy statenebt.

i assume you want to exclude the header rows by Selection.Offset(1, 0) and paste the headers with the last bit.

try something like



Sub Combine()

Worksheets("SourceSheet1").Range("A1").CurrentRegion.Offset(1).Copy Worksheets("DestinationSheet").Range("A2")
Worksheets("SourceSheet2").Range("A1").CurrentRegion.Offset(1).Copy Worksheets("DestinationSheet").Range("A65536").End(xlUp)(2)
Worksheets("SourceSheet1").Range("A1").CurrentRegion.Rows(1).Copy Worksheets("DestinationSheet").Range("A1")

End Sub




Thank you for agreeing to help, mancubus.

I'm ultimately wishing to combine data from the two source sheets into the Destination Sheet. Your code works for the paste, though it replaces what was pasted (instead of pasting on the next available/blank record of the Destination Sheet). Any ideas?

Thank you!

mancubus
09-25-2014, 12:21 PM
you are welcome.

destination sheet is assumed to bu blank. if it already contains previously pasted data -with headers- try like:



Sub Combine()

Worksheets("SourceSheet1").Range("A1").CurrentRegion.Offset(1).Copy Worksheets("DestinationSheet").Range("A" & Rows.Count).End(xlUp).Offset(1)
Worksheets("SourceSheet2").Range("A1").CurrentRegion.Offset(1).Copy Worksheets("DestinationSheet").Range("A" & Rows.Count).End(xlUp).Offset(1)

End Sub

mb314
09-25-2014, 12:32 PM
you are welcome.

destination sheet is assumed to bu blank. if it already contains previously pasted data -with headers- try like:



Sub Combine()

Worksheets("SourceSheet1").Range("A1").CurrentRegion.Offset(1).Copy Worksheets("DestinationSheet").Range("A" & Rows.Count).End(xlUp).Offset(1)
Worksheets("SourceSheet2").Range("A1").CurrentRegion.Offset(1).Copy Worksheets("DestinationSheet").Range("A" & Rows.Count).End(xlUp).Offset(1)

End Sub




This works well, thanks! The only other thing is that it will not copy if there are missing values in Column A. Are there any workarounds to still copy regardless?

mancubus
09-25-2014, 01:15 PM
posting your question here is enough. you dont need to pm the same question.

does your table contain a blank row? otherwise CurrenRegion contains all connected cells, even there are some blank cells.



Sub Combine()


Dim LastRow As Long, LastCol As Long

With Worksheets("SourceSheet1")
LastRow = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
LastCol = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
.Range(.Cells(2, 1), .Cells(LastRow, LastCol)).Copy Worksheets("DestinationSheet").Range("A" & Rows.Count).End(xlUp).Offset(1)
End With

With Worksheets("SourceSheet2")
LastRow = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
LastCol = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
.Range(.Cells(2, 1), .Cells(LastRow, LastCol)).Copy Worksheets("DestinationSheet").Range("A" & Rows.Count).End(xlUp).Offset(1)
End With

End Sub