ワークシートをループし、それぞれの最後の行を別のシートに貼り付けます

Question

ブック内のすべてのワークシートをループし、最後に使用した行を見つけてaggregateという新しいワークシートに貼り付けようとしています。問題はループ中にワークシートaggregateの行を上書きしてしまうことです。私は最初のワークシートの最後の行をコピーして、集約するように貼り付けたいと思います。次に、2番目のワークシートの最後の行をコピーして、次の番号に貼り付けます。空行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時間を過ごしましたが、運にしています。助けてください。

Answer 1

、次いで.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 

Answer 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は、ワークシート関数であるので、私はまた、あなたのSubプロシージャの名前を変更しました。問題は、列Aのデータを持っていないいくつかの行に由来する場合