これでやりたいことは出来ると思いますが行3~17に対応した物です。
以降の行に対応させるには若干改良が必要となります。
単純にセル挿入のみとなります
1~18の番号の振り直しには対応しています
一応テストはしてあります
------------以下マクロの内容---------------
Sub Macro1()
'-------変数の宣言---------
Dim con As Integer
Dim con1 As Integer
Dim con2 As Integer
Dim con3 As Integer
'-------本体---------
con2 = 3
For con = 1 To 18 ---------単純に18回繰り返し
con1 = Cells(con2, 8) ------Cellsを使ってセルの内容をcon1に代入
If con1 <> 0 Then ------con1が0以外だったら以下の処理をしなさい
For con3 = 1 To con1 ----con3をcon1回繰り返し
Range(Cells(con2 + con3, 1), Cells(con2 + con3, 8)).Select -------Cellsを使ってセル範囲指定
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove ---------範囲指定された場所にセル挿入
Next
End If
con2 = con2 + 1
Next
'--------リナンバー-----------(1~18を振り直します)
Range("A3") = 1
Range("A3:A4").Select
Selection.AutoFill Destination:=Range("A3:A21"), Type:=xlFillDefault
Range("A3:A21").Select
End Sub
お礼
できました!!! ありがとうございました!