EXCEL VBA 自動で8行毎に行を挿入したい

質問

お世話になります。

添付左図のような表があります。
この表をボタンをクリックしたら右図の表の様にするためのVBAロジックをご教授いただけませんでしょうか？(右図の黄色部分の行を自動で挿入したいのです)

この表は担当者一人に対して売上区分というものをA-Hまで設けているため、一人のデータが必ず8行になります。
担当者数は現在は100名程度ですが、その都度変わるため可変にしたいです。

この担当者毎に8行あるデータを、ボタンを押したら新規に下行を挿入して[A+B]、続けて下行を挿入して[C+D]、[E+F]、[G+H]という具合に行を挿入する動作を全担当者のデータに全てに対して実施したいのです。

どなたかご教授いただけますでしょうか？
よろしくお願い致します。

環境 windows XP SP3 Excel2003

回答No.1

keithin · ベストアンサー

＞一人のデータが必ず8行になります。

これが事実である前提で。

sub macro1()
　dim LastRow as long
　dim r as long
　lastrow = range("A65536").end(xlup).row + 1
　cells(lastrow, "A").resize(4,3).formular1c1 = "=R[-1]C"
　cells(lastrow, "D").formular1c1 = "=R[-8]&""+""&R[-7]C"　’若しくは単に ="A+B"
　cells(lastrow + 1, "D").formular1c1 = "=R[-7]&""+""&R[-6]C"　’以下同じ
　cells(lastrow + 2, "D").formular1c1 = "=R[-6]&""+""&R[-5]C"
　cells(lastrow + 3, "D").formular1c1 = "=R[-5]&""+""&R[-4]C"

　for r = lastrow - 8 to 3 step -8
　　range("A65536").end(xlup).offset(-3).resize(4,1).entirerow.copy
　　cells(r, "A").insert
　next r

’必要に応じて生かす
’range("A1").currentregion.value = range("A1").currentregion.value
end sub

お礼

keithinさん、早速のご回答ありがとうございます！

ご教授いただきました方法で完璧に実現できました!!

いつもご丁寧なご説明誠にありがとうございます。
本当にありがとうございました。

回答No.2

tom04

こんばんは！
D列は
「A+B」のような文字列表示でよい訳ですよね？
（足し算ではないという解釈）

＞ボタンをクリックしたら・・・

とありますので、コマンドボタンを挿入したとしての一例です。

Private Sub CommandButton1_Click()
Dim i As Long, k As Long
For i = Cells(Rows.Count, 1).End(xlUp).Row To 9 Step -8
Rows(i + 1 & ":" & i + 4).Insert
For k = 1 To 4
With Cells(i + k, 1)
.Value = .Offset(-1)
.Offset(, 1) = .Offset(-1, 1)
.Offset(, 2) = .Offset(-1, 2)
.Offset(, 3) = .Offset(-9 + k, 3) & "+" & .Offset(-8 + k, 3)
End With
Next k
Next i
End Sub

こんなんではどうでしょうか？m（_ _）m

お礼

tom04さん、早速のご回答ありがとうございます！

ご教授いただきました方法で完璧に実現できました!!

いつもいつもご丁寧なご説明本当にありがとうございます!!!
本当に助かりました(^^)。

ありがとうございました。