別ブックから複数列を転記、蓄積したいのですが、一行目しか転記されません。

前提・実現したいこと

二種類のブックA,Bを使用し、Bに記入した複数行のデータをAに転記、蓄積できるシステムを作っているのですが、一番上の一列目しか転記されません。データの転記後、ブックBに記入されたデータは全て削除されます。

初めて業務でマクロを使用しており、以下拙い説明かと思いますが、不明瞭な点があれば追記致しますので、皆様のご指摘、アドバイスいただければ大変嬉しいです。

発生している問題・エラーメッセージ

ブックBに記入された複数行のデータ（6行目以降）のうち、一番上の行（6行目）は転記されるのですが、それ以降（7行目から）は転記されません。転記後の削除に関しましては、ブックB上の全ての行が上手く削除されます。
エラーメッセージは表示されませんでした。

![ブックB転記前](a9eb6ff7e9bcd9c7cef3e3bcd6b6c599.png)

![ブックA転記後　最終行が9行目だったため、10行目に転記されました。ブックBの6行目のみ転記されました。](97a34d9295ce8634049a6dff8e4703bf.png)

![転記後ブックBは削除されました](25cb93bb8008e042f3624de1b932296a.png)

該当のソースコード

Sub Transfer()

> ブックAにデータを蓄積していくため、ブックAの最終行を取得するためのgを指定しました。
 g = Workbooks("A.xlsm").Worksheets("Sheet1").Range("A65536").End(xlUp).Row + 1

> ブックBの6行目から最終行目までの全てのデータを転機するため、ブックBの行をiとして指定し、For Nextを利用しました。
 Dim i
 For i = 6 To Cells(Rows.Count, 1).End(xlUp).Row
  With Workbooks("B.xlsx").Worksheets("Input")
   Workbooks("B.xlsm").Worksheets("Sheet1").Range("A" & g) = .Range("A" & i)
   Workbooks("B.xlsm").Worksheets("Sheet1").Range("b" & g) = .Range("B" & i)
   Workbooks("B.xlsm").Worksheets("Sheet1").Range("c" & g) = .Range("C" & i)
   Workbooks("B.xlsm").Worksheets("Sheet1").Range("d" & g) = .Range("D" & i)
   Workbooks("B.xlsm").Worksheets("Sheet1").Range("e" & g) = .Range("E" & i)
   Workbooks("B.xlsm").Worksheets("Sheet1").Range("f" & g) = .Range("F" & i)
   Workbooks("B.xlsm").Worksheets("Sheet1").Range("g" & g) = .Range("G" & i)
   Workbooks("B.xlsm").Worksheets("Sheet1").Range("h" & g) = .Range("H" & i)
   Workbooks("B.xlsm").Worksheets("Sheet1").Range("i" & g) = .Range("I" & i)
   Workbooks("B.xlsm").Worksheets("Sheet1").Range("j" & g) = .Range("J" & i)
   Workbooks("B.xlsm").Worksheets("Sheet1").Range("k" & g) = .Range("K" & i)
   Workbooks("B.xlsm").Worksheets("Sheet1").Range("l" & g) = .Range("L" & i)
   Workbooks("B.xlsm").Worksheets("Sheet1").Range("m" & g) = .Range("M" & i)
   Workbooks("B.xlsm").Worksheets("Sheet1").Range("n" & g) = .Range("N" & i)
 End With
 Next i
 
> ブックBの6から最終行目を削除するため、行数目をjとして指定し、For Nextを利用しました。
 Dim j
 For j = 6 To Cells(Rows.Count, 1).End(xlUp).Row
 With Workbooks("B.xlsx").Worksheets("Input")
  .Range("A" & j) = ClearContents
  .Range("B" & j) = ClearContents
  .Range("C" & j) = ClearContents
  .Range("D" & j) = ClearContents
  .Range("E" & j) = ClearContents
  .Range("F" & j) = ClearContents
  .Range("G" & j) = ClearContents
  .Range("H" & j) = ClearContents
  .Range("I" & j) = ClearContents
  .Range("J" & j) = ClearContents
  .Range("K" & j) = ClearContents
  .Range("L" & j) = ClearContents
  .Range("M" & j) = ClearContents
  .Range("N" & j) = ClearContents
 
  End With
  Next j
 
End Sub

試したこと

Debug StepInを利用して最初から確認したところ、For i = 6 To Cells(Rows.Count, 1).End(xlUp).Rowの一巡目は転機されました。二巡目からはマクロは進行しているのですが、転記はされませんでした。

補足情報（FW/ツールのバージョンなど）

ここにより詳細な情報を記載してください。

行動規範の内容に同意します

回答1件

ベストアンサー

こんな感じでどうでしょうか。

VBA
1For i = 6 To Cells(Rows.Count, 1).End(xlUp).Row
2  With Workbooks("B.xlsx").Worksheets("Input")
3   Workbooks("A.xlsm").Worksheets("Sheet1").Range("A" & g) = .Range("A" & i)
4   Workbooks("A.xlsm").Worksheets("Sheet1").Range("b" & g) = .Range("B" & i)
5   Workbooks("A.xlsm").Worksheets("Sheet1").Range("c" & g) = .Range("C" & i)
6   Workbooks("A.xlsm").Worksheets("Sheet1").Range("d" & g) = .Range("D" & i)
7   Workbooks("A.xlsm").Worksheets("Sheet1").Range("e" & g) = .Range("E" & i)
8   Workbooks("A.xlsm").Worksheets("Sheet1").Range("f" & g) = .Range("F" & i)
9   Workbooks("A.xlsm").Worksheets("Sheet1").Range("g" & g) = .Range("G" & i)
10   Workbooks("A.xlsm").Worksheets("Sheet1").Range("h" & g) = .Range("H" & i)
11   Workbooks("A.xlsm").Worksheets("Sheet1").Range("i" & g) = .Range("I" & i)
12   Workbooks("A.xlsm").Worksheets("Sheet1").Range("j" & g) = .Range("J" & i)
13   Workbooks("A.xlsm").Worksheets("Sheet1").Range("k" & g) = .Range("K" & i)
14   Workbooks("A.xlsm").Worksheets("Sheet1").Range("l" & g) = .Range("L" & i)
15   Workbooks("A.xlsm").Worksheets("Sheet1").Range("m" & g) = .Range("M" & i)
16   Workbooks("A.xlsm").Worksheets("Sheet1").Range("n" & g) = .Range("N" & i)
17 End With
18 g = g + 1 
19Next i
20