Macro to insert multiple rows between existin [Solved/Closed]

Report
Posts
4
Registration date
Friday July 27, 2012
Status
Member
Last seen
July 29, 2012
-
 Pedro -
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!

5 replies

Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
791
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
3
Thank you

A few words of thanks would be greatly appreciated. Add comment

CCM 2942 users have said thank you to us this month

This is giving a warning " Cant execute code in break mode"
Excellent! thank you very much!
Posts
4
Registration date
Friday July 27, 2012
Status
Member
Last seen
July 29, 2012
1
OMG!!!!!!!!!!!!!!!!!!!!!!!!!........................THANK YOU!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

It Works perfectly. You're the best!

Sending You Much Aloha!
Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
791
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
Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
791
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
Posts
4
Registration date
Friday July 27, 2012
Status
Member
Last seen
July 29, 2012
1
OH! okay...Thank you!