macro to add rows and copy row data

anna1

New Member
Joined
Mar 8, 2004
Messages
3
I need a macro that will add set number of rows between each existing row of data in my spreadsheet. Also the macro needs to allow the data row above the newly added blank rows to be copied into these blank rows. My spreadsheet has 28,000 rows of data that needs to be modified in this manner and I need a quick way to do this.

Any help will be greatly appreciated. :rolleyes:
 

Some videos you may like

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".

TryingToLearn

Well-known Member
Joined
Sep 10, 2003
Messages
723
I believe this is what you asked for but I'm not sure it's what you meant.
It will find the last entry in column A, assume that is the last used row, add 2 blank lines after it, copy the last row to the line below and then work backwards though the entire file in the same matter.

End result, 2 lines of identical data followed by a blank.

Code:
Sub addNcopy()
    Dim r As Integer, Count As Integer
    Application.ScreenUpdating = False
    Count = Range("a65536").End(xlUp).Row
    For r = Count To 2 Step -1    ' work backwards to account for added lines
        If Cells(r, 1) <> vbNullString Then  ' skip blank lines
            ActiveSheet.Rows(r + 1).Insert
            ActiveSheet.Rows(r + 1).Insert
            ActiveSheet.Rows(r).Copy Destination:=ActiveSheet.Rows(r + 1)
        End If
    Next r
    Application.ScreenUpdating = True
End Sub
 

anna1

New Member
Joined
Mar 8, 2004
Messages
3
Thanks for the help. It is close to what I need. Is there a way that each data row can be copied into all the blank rows. For ex. I have two data rows with "data a b c" and "data d e f". I want to add two blank rows between them and then copy the data row above into the two blank rows, etc. "Like this:

data a b c
data a b c
data a b c
data d e f
data d e f
data d e f
 

TryingToLearn

Well-known Member
Joined
Sep 10, 2003
Messages
723
You mean:

Code:
Sub addNcopy() 
    Dim r As Integer, Count As Integer 
    Application.ScreenUpdating = False 
    Count = Range("a65536").End(xlUp).Row 
    For r = Count To 2 Step -1    ' work backwards to account for added lines 
        If Cells(r, 1) <> vbNullString Then  ' skip blank lines 
            ActiveSheet.Rows(r + 1).Insert 
            ActiveSheet.Rows(r + 1).Insert 
            ActiveSheet.Rows(r).Copy Destination:=ActiveSheet.Rows(r + 1) 
ActiveSheet.Rows(r).Copy Destination:=ActiveSheet.Rows(r + 2)
        End If 
    Next r 
    Application.ScreenUpdating = True 
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,122,901
Messages
5,598,766
Members
414,259
Latest member
beetle12

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top