I would like to copy to the last row all rows with values from each sheet, in order to have a single table in the "Resume" sheet. The other tables are on sheets "AA", "BB", "CC" and "DD" and have the same header as the Resume table.In the summary table, the pasted tables must be pasted in the first unfilled line.
My code currently:
Sub copy()
Sheets("AA").Select
Range("A2:J5").Select
Selection.copy
Sheets("RESUME").Select
Range("A2").Select
ActiveSheet.Paste
Sheets("BB").Select
Range("A2:J4").Select
Application.CutCopyMode = False
Selection.copy
Sheets("RESUME").Select
Range("A6").Select
ActiveSheet.Paste
Sheets("CC").Select
Range("A2:J7").Select
Application.CutCopyMode = False
Selection.copy
Sheets("DD").Select
Range("A5").Select
Sheets("RESUME").Select
Range("A9").Select
ActiveSheet.Paste
Sheets("DD").Select
Range("A2:J4").Select
Application.CutCopyMode = False
Selection.copy
Sheets("RESUME").Select
Range("A15").Select
ActiveSheet.Paste
Range("A1").Select
End Sub
CodePudding user response:
you should probably go 1 by 1, first "AA" sheet, then "BB", etc.
I'd go like this:
Sheets("AA").Activate
lrsheet = Cells.Find("*", Cells(1, 1), xlFormulas, xlPart, xlByRows, xlPrevious, False).Row ' this line of code gives you the last filled line on your sheet
Worksheets("AA").Range("A2:A" & lr).Copy Worksheets("RESUME").Range("A2")
lrresume = Cells.Find("*", Cells(1, 1), xlFormulas, xlPart, xlByRows, xlPrevious, False).Row ' this line of code gives you the last filled line on your resume
For next sheet i'd go like this:
Sheets("BB").Activate
lrsheet = Cells.Find("*", Cells(1, 1), xlFormulas, xlPart, xlByRows, xlPrevious, False).Row
Worksheets("BB").Range("A2:A" & lr).Copy Worksheets("RESUME").Range("A" & lr)
lrresume = Cells.Find("*", Cells(1, 1), xlFormulas, xlPart, xlByRows, xlPrevious, False).Row ' updating "resume" last row
And the rest should be the same logic
Hope it helps!
CodePudding user response:
I would create a loop that ran through your source sheets and pasted each to the bottom of the Resume tab like this:
Sub copy_loop()
' loop through the sheet names
For Each ws In Worksheets(Array("AA", "BB", "CC", "DD"))
' find the bottom of the data for that sheet, using column A to find bottom-most value
SourceLastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
' find the bottom of the data on Resume sheet, using column A to find bottom-most value
DestinationLastRow = Worksheets("Resume").Cells(Worksheets("Resume").Rows.Count, "A").End(xlUp).Row
' Copy from the source location to the row below the last one containing data on Resume tab
ws.Range("A2:J" & SourceLastRow).Copy Worksheets("Resume").Range("A" & DestinationLastRow 1)
Next
End Sub