循环工作表并将每个行的最后一行粘贴到不同的工作表中

时间:2017-11-10 00:23:30

标签: excel excel-vba vba

我正在尝试遍历工作簿中的所有工作表,找到每个工作表中最后使用的行,并将该行粘贴到名为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

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

2 个答案:

答案 0 :(得分:3)

如果你的问题源于某些行没有A列中的数据,那么这个使用.Find方法确定最后一行的宏应该是有用的:

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

答案 1 :(得分:2)

您的代码看起来不应该像您描述的那样失败。但是,你似乎在方法中反弹;例如你set wksDest没有声明变量然后从不使用它,你使用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 是一个工作表函数。