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

Posts
4
Registration date
Friday July 27, 2012
Last seen
July 29, 2012
- Jul 27, 2012 at 08:51 PM - Latest reply:  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!

See more 

7 replies

Best answer
Posts
1865
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
Jul 27, 2012 at 11:31 PM
3
Thank you
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

Thank you, venkat1926 3

Something to say? Add comment

CCM has helped 1692 users 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
Last seen
July 29, 2012
Jul 27, 2012 at 11:46 PM
1
Thank you
OMG!!!!!!!!!!!!!!!!!!!!!!!!!........................THANK YOU!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

It Works perfectly. You're the best!

Sending You Much Aloha!
Posts
1865
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
Jul 27, 2012 at 11:37 PM
0
Thank you
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
1865
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
Jul 27, 2012 at 11:55 PM
0
Thank you
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
Last seen
July 29, 2012
Jul 29, 2012 at 12:12 PM
0
Thank you
OH! okay...Thank you!