Insert Blank Rows Every Nth Lines (ie Breaks at 31, 61, 91, 121)

[traelor]

I have yet to see a solid solution about this:

I need help making a macro that can insert 6 blank rows, every 60 lines. I have tried the one developed by Kutools shown below, this code will insert 6 blank rows, count another 60 and then insert another 6.

This causes my data to break at (61, 127, 193 ect.) RATHER than (61, 121, 181 ect.)

Sub InsertRowsAtIntervals()
'Updateby Extendoffice
Dim Rng As Range
Dim xInterval As Integer
Dim xRows As Integer
Dim xRowsCount As Integer
Dim xNum1 As Integer
Dim xNum2 As Integer
Dim WorkRng As Range
Dim xWs As Worksheet
xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
xRowsCount = WorkRng.Rows.Count
xInterval = Application.InputBox("Enter row interval. ", xTitleId, 1, Type:=1)
xRows = Application.InputBox("How many rows to insert at each interval? ", xTitleId, 1, Type:=1)
xNum1 = WorkRng.Row + xInterval
xNum2 = xRows + xInterval
Set xWs = WorkRng.Parent
For i = 1 To Int(xRowsCount / xInterval)
xWs.Range(xWs.Cells(xNum1, WorkRng.Column), xWs.Cells(xNum1 + xRows - 1, WorkRng.Column)).Select
Application.Selection.EntireRow.Insert
xNum1 = xNum1 + xNum2
Next
End Sub

 

[bobsan42]

To avoid building up an error like this I believe the inserting should be done from the bottom up. Or you should reduce the 60 by 6 each loop. Or some way of compensation. I will look in it in details tomorrow.
However if you only need it for printing simply insert a page break.
To make it clear post some data samples to clarify exactly what are the expected results.

 

[EXCEL MAX]

Hello Traelor,
with a little changes in you code you can try in this way...

Sub InsertRowsAtIntervals()

'Updateby Extendoffice
    Dim Rng As Range
    Dim xInterval As Integer
    Dim xRows As Integer
    Dim xRowsCount As Integer
    Dim xNum1 As Integer
    Dim xNum2 As Integer
    Dim WorkRng As Range
    Dim xWs As Worksheet
    
    xTitleId = "KutoolsforExcel"
    Set WorkRng = Application.Selection
    Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
    xRowsCount = WorkRng.Rows.Count
EX: xInterval = Application.InputBox("Enter row interval. ", xTitleId, 1, Type:=1)
    xRows = Application.InputBox("How many rows to insert at each interval? ", xTitleId, 1, Type:=1)
    If xInterval <= xRows Then
        MsgBox "Interval needs to be greater then " _
             & "number of the inserted rows.": GoTo EX
    End If
    For i = 1 To Int(xRowsCount / xInterval)
        Rows("" & WorkRng.Row + i * xInterval & ":" & _
                  WorkRng.Row + i * xInterval + xRows - 1 & ""). _
                  Insert Shift:=xlDown
    Next

End Sub

 

[traelor]

Hello Traelor,
with a little changes in you code you can try in this way...

Sub InsertRowsAtIntervals()

'Updateby Extendoffice
    Dim Rng As Range
    Dim xInterval As Integer
    Dim xRows As Integer
    Dim xRowsCount As Integer
    Dim xNum1 As Integer
    Dim xNum2 As Integer
    Dim WorkRng As Range
    Dim xWs As Worksheet
   
    xTitleId = "KutoolsforExcel"
    Set WorkRng = Application.Selection
    Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
    xRowsCount = WorkRng.Rows.Count
EX: xInterval = Application.InputBox("Enter row interval. ", xTitleId, 1, Type:=1)
    xRows = Application.InputBox("How many rows to insert at each interval? ", xTitleId, 1, Type:=1)
    If xInterval <= xRows Then
        MsgBox "Interval needs to be greater then " _
             & "number of the inserted rows.": GoTo EX
    End If
    For i = 1 To Int(xRowsCount / xInterval)
        Rows("" & WorkRng.Row + i * xInterval & ":" & _
                  WorkRng.Row + i * xInterval + xRows - 1 & ""). _
                  Insert Shift:=xlDown
    Next

End Sub

Thank you this is exactly what I need

 

[EXCEL MAX]

You are welcome.