vbaでブック間でコピーペーストする際に空白のシートに上から順番に貼りつける方法

Question

ブック間でデータの整理を行いたいです。

Aのブックのすべてのシートの66行目の値を全て，Bのブックのシート１の行の上から順番に貼りつけていきたいです。

現在のコードは以下です。

Sub Macro3()

Dim i As Long
For i = 1 To Sheets.Count
    Windows("A").Activate
    Sheets(i).Select
    Rows("66:66").Select
    Selection.Copy
    
    Call Macro4
    
Next i

End Sub

Sub Macro4()

Dim j As Long
For j = 1 To 102
  
    Windows("B").Activate
    Rows(i).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
Next j

End Sub

これだとAのブックの66行目をBのシート1の1～102行目まで貼り付けられる作業がAのシート分繰り返されます。

Aの66行目の値をコピー，Bのシート1の1行目に貼り付け，Aのシートが変わり66行目をコピー，Bno2行目に貼り付け，という風にしていきたいです。

よろしくお願いいたします。

Answer 1

j=j+1を使ってうまくいきました

Answer 2

こんな形で実現できないでしょうか。
ブック間コピーペーストの代わりに、ブック間で値の代入としています。

Sub Macro5()
    Dim i As Long 'ワークブックA シートカウンター
    Dim j As Long 'ワークブックB 行カウンター
    Workbooks("B").Activate
    j = 1
    For i = 1 To Workbooks("A").Worksheets.Count
        '以下、ブック間で値の代入
        Rows(j).Value = Workbooks("A").Worksheets(i).Rows(66).Value
        j = j + 1
    Next i
End Sub

Comments

[退会済みユーザー]

ありがとうございます。
内容はなるほど！と思ったんですが，うまくいきませんでした。。。

[TanakaHiroaki]

解決できたようで何よりです。