Copy every nth Row

Retail_Therapy

New Member
Joined
Nov 22, 2017
Messages
10
I need to copy columns A to D, down 4 rows until the next item (then down 4 rows for next item, and etc).

Is there an easy way to formulate drag down without manually going through every item? I have 5000+ unique items to drag down.

[TABLE="width: 500"]
<tbody>[TR]
[TD]SS17[/TD]
[TD]ANKLE BOOTS[/TD]
[TD]D AUDALIES HIGH[/TD]
[TD]D723XB0LC09C9999[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]SS17[/TD]
[TD]SANDALS[/TD]
[TD]D KENNITY MID[/TD]
[TD]D625TG0SL9BC4007[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.
Retail_Therapy,

Pending your data is in Sheet1 and the data is in rows 1, 6, 11, etc. The following code should work perfect.

Code:
Sub CopyDown()

    lastRow = Range("A" & Rows.Count).End(xlUp).Row + 4
    i = 1
    j = 5
    
While i < lastRow

    Sheets(1).Range("A" & i & ":D" & i).Copy Sheets(1).Range("A" & i & ":D" & j)
    i = i + 5
    j = j + 5

Wend

End Sub

If the data is not in this format, please let me know or adjust accordingly.

Bill
 
Last edited:
Upvote 0
Hi & welcome to the board.
How about
Code:
Sub CopyDown()
    
    Dim UsdRws As Long
    Dim Cnt As Long
    
    UsdRws = Range("A" & Rows.Count).End(xlUp).Offset(4).Row
    
    For Cnt = 1 To UsdRws Step 5
        Range("A" & Cnt).Resize(5, 4).FillDown
    Next Cnt
    

End Sub
 
Upvote 0
Hi Bill,
Sorry I'm not too familar with codes,
Do I insert anything before/after the code you provided in my module?
Normally the codes I use have "sub ----" and "end sub" at the begining/end.

thank you very much for your assistance.
 
Upvote 0
Retail_Therapy,

I edited it, it now includes the necessary information. You can now copy and paste into a module and click Run.

Bill
 
Upvote 0
Kim,

Try:

Code:
[COLOR=#333333]Sub CopyDown()[/COLOR]
    lastRow = Range("A" & Rows.Count).End(xlUp).Row + 4
    i = 1
    j = 5
    
While i < lastRow

    Sheets(1).Range("A" & i).Copy Sheets(1).Range("A" & i & ":A" & j)
    i = i + 5
    j = j + 5

Wend
 [COLOR=#333333]End Sub[/COLOR]
 
Upvote 0

Forum statistics

Threads
1,224,910
Messages
6,181,675
Members
453,061
Latest member
schiefA

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
Back
Top