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:
 

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.

TryingToLearn

Well-known Member
Joined
Sep 10, 2003
Messages
730
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
730
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
 

Forum statistics

Threads
1,176,103
Messages
5,901,398
Members
434,890
Latest member
creativimama

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