在工作表中循环，并粘贴每个表格的最后一行

我试图循环遍历工作簿中的所有工作表，find每个工作表中最后一次使用的行，并将该行粘贴到名为aggregate的新工作表中。 问题在于它在循环时覆盖工作表aggregate的行。 我想复制第一张工作表的最后一行，粘贴它进行聚合。 接下来，复制第二个工作表的最后一行，并将其粘贴到aggregate工作表中的下一个空行等等。 我的代码出于某种原因不增加aggregate工作表中的下一个“空”行。

码：

 Sub aggregate() ' ' aggregate Macro ' ' Dim ws As Worksheet Dim LastRow As Long Set wksDest = ActiveWorkbook.Sheets("aggregate") For Each ws In Worksheets If ws.Name <> "aggregate" Then With ws ws.Cells(Rows.Count, 1).End(xlUp).EntireRow.Copy _ Destination:=Worksheets("aggregate").Cells(Rows.Count,"A").End(xlUp).Offset(1) Application.CutCopyMode = False End With End If Next ws End Sub 

我花了两个小时才发现问题，但没有运气。 请帮忙。

Answer 1

如果您的问题源于A列中没有数据的行，那么使用.Find方法确定最后一行的这个macros应该是有用的：

 Option Explicit Sub aggregate() ' ' aggregate Macro ' ' Dim ws As Worksheet ', wksDest As Worksheet Dim wsDest As Worksheet Dim c As Range, d As Range Set wsDest = ActiveWorkbook.Sheets("aggregate") For Each ws In Worksheets If ws.Name <> "aggregate" Then With ws Set c = .Cells.Find(what:="*", after:=.Cells(1, 1), LookIn:=xlValues, _ searchorder:=xlByRows, searchdirection:=xlPrevious) With wsDest Set d = .Cells.Find(what:="*", after:=.Cells(1, 1), LookIn:=xlValues, _ searchorder:=xlByRows, searchdirection:=xlPrevious) If d Is Nothing Then Set d = .Cells(1, 1) 'check if wsDest is blank End With If Not c Is Nothing Then _ c.EntireRow.Copy Destination:=d.Offset(1, 0).EntireRow Application.CutCopyMode = False End With End If Next ws End Sub 

Answer 2

你的代码看起来不像你描述的那样会失败。 但是，你似乎在反弹和退出方法; 例如你set wksDest而不声明variables，然后从不使用它，你使用With ws块但是不要使用它。

这是一个快速重写。

 Sub aggregateIt() ' ' aggregate Macro ' Dim ws As Worksheet, wksDest As Worksheet Set wksDest = ActiveWorkbook.Worksheets("aggregate") For Each ws In Worksheets If ws.Name <> wksDest.Name Then With ws .Cells(.Rows.Count, 1).End(xlUp).EntireRow.Copy _ Destination:=wksDest.Cells(.Rows.Count, "A").End(xlUp).Offset(1) Application.CutCopyMode = False End With End If Next ws End Sub 

我也重命名你的子程序，因为AGGREGATE是一个工作表函数。