我正在尝试遍历工作簿中的所有工作表,找到每个工作表中最后使用的行,并将该行粘贴到名为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
我花了最后两个小时才发现问题,但没有运气。请帮忙。
答案 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 是一个工作表函数。