コピーした行の挿入

Rows(i).Copy
Rows(i).Insert Shift:=xlDown

すべての行を、６行増やして、AQ列に６種のキーワードを入れる
Sub 全行6展開()

Dim tiku As Variant
tiku = Array("A", "B", "C・D", "E", "F", "G")
Dim maxrow
With ActiveSheet.UsedRange
maxrow = .Rows(.Rows.Count).Row
End With

----- べんりあつめ。-----

Dim i
Dim ii
For ii = 1 To maxrow
For i = 1 To 6
Rows(ii * 7 - 6).Copy
Rows(ii * 7 - 6).Insert Shift:=xlDown
Cells(ii * 7 - 5, 43).Value = tiku(i - 1)
Next i
Next ii

End Sub