エクセル2016にて、行挿入&コピーの繰り返しをするマクロを教えてください。

１行目に項目がある。
2行目よりデータがある。
データ行は、それぞれのファイルごとに数が違う。
データ１行につき、それぞれ23行ずつ行挿入したい。
その挿入したところに、AからGのデータをコピーしたい。

1行目　　項目
2行目　A～AE(このデータが書き込まれている範囲はかわらない)
3行目以降に2行目のA～Gをコピーする(H以降はコピーせず、空白のまま)
次に、挿入後のデータがある26行目も同じように23行行挿入し、26行目のA～Gをコピーしたい。
作業は下記の通りになります。

Sub Macro1()
'
' Macro1 Macro
'

'
Rows("3:25").Select
Range("G3").Activate
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("A2:G2").Select
Selection.AutoFill Destination:=Range("A2:G25"), Type:=xlFillDefault
Range("A2:G25").Select
Rows("27:49").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A26:G26").Select
Selection.AutoFill Destination:=Range("A26:G49"), Type:=xlFillDefault
Range("A26:G49").Select
Rows("51:73").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A50:G50").Select
Selection.AutoFill Destination:=Range("A50:G73"), Type:=xlFillDefault
Range("A50:G73").Select
End Sub
これを最終データがあるところまで繰り返し作業するためのマクロは、どのようにすればよいかご教示願えますでしょうか。
マクロ初心者なので、これをどのようにまとめればよいか悩んでしまいました。お力添えをお願いいたします。

No.1 ベストアンサー 回答者： tom04 回答日時： 2018/01/26 14:09

こんにちは！

タイトルは「コピー」となっていますが、コードを拝見するとA～G列をオートフィルにしていますね。
オートフィルの操作でやってみました。

一例です。

Sub Sample1()
Dim i As Long
Application.ScreenUpdating = False
For i = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
Rows(i + 1 & ":" & i + 23).Insert
Range(Cells(i, "A"), Cells(i, "G")).AutoFill _
Destination:=Range(Cells(i, "A"), Cells(i + 23, "G"))
Next i
Application.ScreenUpdating = True
MsgBox "完了"
End Sub

こんな感じではどうでしょうか？

※　A列で最終行を取得していますので、
A列は最終行まで何らかのデータが入っているという前提です。m(_ _)m

この回答へのお礼

tomo04様
早速ご教示いただき、ありがとうございました。
まさしく、こちらの作業がしたかったのです。
コピーではなく、オートフィルなんですね。
本当にありがとうございました。

お礼日時：2018/01/26 14:54