如何将 4 tables 转移到摘要 table 直到最后一行 vba 代码？

Question

我有这个 Excel 文件：

我想将每个 sheet 值的所有行复制到最后一行，以便在“简历”sheet 中有一个 table。其他 table 位于 sheet 的“AA”、“BB”、“CC”和“DD”上，并且 header 与简历 table.In 摘要相同table，粘贴的table必须粘贴在第一个空行

我目前的代码：

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

Answer 1

你应该一个接一个地走，先是“AA”sheet，然后是“BB”，等等

我会这样：

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

接下来 sheet 我会这样：

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

剩下的应该是同一个逻辑

希望对您有所帮助！

Answer 2

我会创建一个循环，运行通过您的源工作表并将每个工作表粘贴到“简历”选项卡的底部，如下所示：

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

如何将 4 tables 转移到摘要 table 直到最后一行 vba 代码？

How can I transfer 4 tables to a summary table until last row with vba code?

excel

vba