Macro to add the number of blank rows blow data as it shows

[tonywatsonhelp]

Hi Everyone,
I have a list of data and In column O I have a number, will always be at least 1
I want to insert below each line of data the number of row for that number

So Lets say O10 = the number 10 I want to insert 10 rows below so from 11, but for all the data in every row,
I'm thinking it would be easiest to start at the last row and work up but i dont know how to do this?
please help if you can

Thank you
Tony

 

[Trebor76]

I'm thinking it would be easiest to start at the last row and work up but i dont know how to do this?

Try this (just change the wsSrc variable to the tab name that has the data if it's not Sheet1):

Option Explicit
Sub Macro1()

    Dim wsSrc As Worksheet
    Dim lngRowFrom As Long, lngRowTo As Long, lngRow As Long
    
    Application.ScreenUpdating = False
    
    Set wsSrc = ThisWorkbook.Sheets("Sheet1") '<-Sheet name containing data. Change to suit if necessary.
    lngRowFrom = 1
    lngRowTo = wsSrc.Cells(Rows.Count, "O").End(xlUp).Row
    
    For lngRow = lngRowTo To lngRowFrom Step -1
        If Val(wsSrc.Range("O" & lngRow)) > 0 Then
            wsSrc.Rows(lngRow + 1 & ":" & lngRow + Val(wsSrc.Range("O" & lngRow))).Insert
        End If
    Next lngRow
    
    Application.ScreenUpdating = True    

End Sub

Regards,

Robert

 

[Sahak]

Try this too
Your data before

Run macro

Sub Insert_Rows()
    Dim RowNos As Range
    For Each RowNos In Range("O2:O6")
        If RowNos.Value > 0 And RowNos.Offset(1).Value > 0 Then
            Dim iCount As Long
            Dim i As Long
            iCount = RowNos.Value
            For i = 1 To iCount
                RowNos.Offset(1).EntireRow.Insert
            Next i
        End If
    Next
End Sub

Data after

 

[tonywatsonhelp]

Thanks Trevor and Sahak,
Both ideas worked great so thank you,
Tony

 

[Sahak]

You are very welcome