Macro to insert multiple rows between existin

Solved/Closed
informme808 Posts 4 Registration date Friday July 27, 2012 Status Member Last seen July 29, 2012 - Jul 27, 2012 at 08:51 PM
 Pedro - Jul 11, 2017 at 02:40 PM
Hello,
I am trying to create a macro that will insert 2 blank rows into an existing spreadsheet after every 2 entries. The amount of rows needed will be the same for each entry on the spreadsheet (about 800).

Before Macro:

Title1
Title2
Title3
Title4


After Macro:

Title1
Title2


Title3
Title4

Your quick response will be greatly appreciated, as I am preparing for an audit. Mahalo!

Related:

5 responses

venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 811
Jul 27, 2012 at 11:31 PM
try this macro


Sub test()
    Dim j As Integer, k As Integer, m As Integer
    j = Range("a1").End(xlDown).Row
    k = 3
    m = 2
    Do
        If k Mod 2 = 1 Then
            Range(Cells(k, 1), Cells(k + 1, 2)).EntireRow.Insert
            k = k + 2 * m
          '  MsgBox k
        End If
        If Cells(k, 1) = "" Then Exit Do
    Loop
End Sub
This is giving a warning " Cant execute code in break mode"
Excellent! thank you very much!
informme808 Posts 4 Registration date Friday July 27, 2012 Status Member Last seen July 29, 2012 1
Jul 27, 2012 at 11:46 PM
OMG!!!!!!!!!!!!!!!!!!!!!!!!!........................THANK YOU!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

It Works perfectly. You're the best!

Sending You Much Aloha!
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 811
Jul 27, 2012 at 11:37 PM
modification and more general macro


Sub test()
    Dim j As Integer, k As Integer, m As Integer, n As Integer
    Worksheets("sheet1").Cells.Clear
    Worksheets("sheet2").Cells.Copy Worksheets("sheet1").Range("A1")
    j = Range("a1").End(xlDown).Row
    m = 2  'no. of rows after which blank rows to be inserted
    k = m + 1
    n = 2    'no. of blank rows to be inserted
    Do
        If k Mod 2 = 1 Then
            Range(Cells(k, 1), Cells(k + n - 1, 1)).EntireRow.Insert
            k = k + 2 * m

            'MsgBox k

        End If
        If Cells(k, 1) = "" Then Exit Do
    Loop
End Sub
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 811
Jul 27, 2012 at 11:55 PM
u r welcome

forgot to tell you your original data before insertion of blank rows is copied into sheet2 so that original data is not lost
informme808 Posts 4 Registration date Friday July 27, 2012 Status Member Last seen July 29, 2012 1
Jul 29, 2012 at 12:12 PM
OH! okay...Thank you!