Add Rows one by one (based on a number in a cell)

[gheyman]

I have a CountA formula in:

iRow = Sheet2.Range("B12").Value

In Sheet9 starting in Row 15 I want to Insert a new Row. But I need to do this one at a time. If my value in iRow is 12 I need do this 12X times. I cannot just insert 12 rows at one time because I have a table below. I get an error message if there isnt already 12 empty rows between Row15 and where the second table starts. Therefore I have to loop through - adding a new row one by one.

Any help is appreciated

I was using this code, but as I stated if there arent enough blank rows between row 15 and the second table, this code doesnt work

Sub InsertRows()

Dim iRow As Long

    iRow = Sheet2.Range("B12").Value
    
     '   If Sheet2.Range("B12").Value > 0 Then
        
        Sheet9.Select
    
          Range("A15").EntireRow.Offset(1).Resize(iRow).Insert Shift:=xlDown
    
      '  Else
    
'End If
    
End Sub

 

[gheyman]

Solved

Sub LoopRows()

Dim iRows As Integer
Dim iCount As Integer

'Select the current row
Sheet9.Range("A16").Activate
ActiveCell.EntireRow.Select

On Error GoTo Last
iRows = Sheet2.Range("B12").Value

'Keep on inserting rows until we reach the input number
For iCount = 1 To iRows
Selection.Insert Shift:=xlToDown, CopyOrigin:=xlFormatFromRightorAbove
Next iCount
Last: Exit Sub



End Sub