Insert X rows below row Y based on value in row Y

[lwhyatt]

How can I get Excel to insert x rows below a row based on the value of a cell in that row?

eg if in row 1 cell B1 contains '5' I want 5 rows inserted.

I have a number of rows with different values so I need different gaps inserted between rows.

 

[mrshl9898]

Does this work for you?

Sub addrows()


Dim rownum As Long
Dim addrow As Long


rownum = 1


Do Until Cells(rownum, 2).Value = ""
addrow = Cells(rownum, 2).Value
Rows(rownum + 1 & ":" & addrow + rownum).Insert Shift:=xlDown
rownum = rownum + addrow + 1
Loop


End Sub

 

[lwhyatt]

Great thanks. It's adding one too many rows each time though as I want to re-use the first row. What do I change if the cells specifying the number of rows to add are in I4:I439 ?

 

[DanteAmor]

Try this

Sub Macro2()
    Dim i As Long, n As Long
    For i = Range("I" & Rows.Count).End(xlUp).Row To 4 Step -1
        n = Cells(i, "I").Value
        If n > 0 Then Rows(i + 1 & ":" & i + n).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Next
End Sub