Copy every 6th row and insert/paste underneath. Duplicate every 6th row on same sheet.

J

jsherst

New Member
Joined
May 13, 2014
Messages
10
Hello,

I need a Macro to copy every 6th row (starting at 1) and insert underneath said row. It would look something like this:

1 Black
2 Blue
3 Gold
4 Green
5 Orange
6 Red
7 Black
8 Blue
9 Gold
10 Green
11 Orange
12 Red

Needs to be:

1 Black
1 Black
2 Blue
3 Gold
4 Green
5 Orange
6 Red
7 Black
7 Black
8 Blue
9 Gold
10 Green
11 Orange
12 Red

And repeat this for the entire sheet. If someone can explain what the number variables do in their code I would be able to alter it for my different uses. Sometimes I will need it to duplicate the 6th row, sometimes the 4th, etc.

I have this code that does somethign similar. I can copy every row 'x' number of times. It may be able to be altered to do what I need. It has been so long since I used excel that I have forgotten what each variable does:(

Code: 
Sub insertrows()
MyColumn = "A"
For x = Cells(Rows.Count, MyColumn).End(xlUp).Row To 1 Step -1
       Rows(x).Copy
       Rows(x).Resize(6).Insert
Next x
End Sub
 

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"
Sort by date Sort by votes
jsherst said:
I have this code that does somethign similar. I can copy every row 'x' number of times. It may be able to be altered to do what I need. It has been so long since I used excel that I have forgotten what each variable does:(
Click to expand...
I'll give you a nudge in the right direction. See if you can go from here, but post back if you can't get what you need.


Code: 
Sub insertrows()
MyColumn = "A"
For x = Cells(Rows.Count, MyColumn).End(xlUp).Row To 1 Step <del>-1</del>[COLOR="#FF0000"][B] -6[/B][/COLOR]
       Rows(x).Copy
       Rows(x)<del>.Resize(6)</del>.Insert
Next x
End Sub
 
Upvote 0
Peter_SSs said:
I'll give you a nudge in the right direction. See if you can go from here, but post back if you can't get what you need.


Code: 
Sub insertrows()
MyColumn = "A"
For x = Cells(Rows.Count, MyColumn).End(xlUp).Row To 1 Step <del>-1</del>[COLOR=#FF0000][B] -6[/B][/COLOR]
       Rows(x).Copy
       Rows(x)<del>.Resize(6)</del>.Insert
Next x
End Sub
Click to expand...


Hello Peter,

I am still having a hard time with the code. I have entered it just as follows:

Code: 
Sub insertrows()
MyColumn = "A"
For x = Cells(Rows.Count, MyColumn).End(xlUp).Row To 1 Step -6<del></del>[COLOR=#FF0000][/COLOR]
       Rows(x).Copy
       Rows(x)<del></del>.Insert
Next x
End Sub

I have fooled around with the numbers several times but cant seem to get it to do what I want. I cant believe how much I forgot about the above formula.

Thanks for the prompt reply. I am surprised anyone answered me so late (my time its 11pm)
 
Upvote 0
jsherst said:
I am surprised anyone answered me so late (my time its 11pm)
Click to expand...
Ah, that's the advantage of using a popular international forum - it never sleeps. Only 6:30 pm my time. :)


jsherst said:
I have fooled around with the numbers several times but cant seem to get it to do what I want.
Click to expand...
Can you confirm that it does copy every 6th row, just maybe not quite the right rows?

If you have 13 rows of data in column A, can you confirm exactly which rows should be duplicated? List them from the bottom up.
 
Upvote 0
Using that exact code you sent me it took this original:

1 Black
2 Blue
3 Gold
4 Green
5 Orange
6 Red
7 Black
8 Blue
9 Gold
10 Green
11 Orange
12 Red
13 Black
14 Blue
15 Gold
16 Green
17 Orange
18 Red

And changed it to this:

1 Black
2 Blue
3 Gold
4 Green
5 Orange
6 Red
6 Red
7 Black
8 Blue
9 Gold
10 Green
11 Orange
12 Red
12 Red
13 Black
14 Blue
15 Gold
16 Green
17 Orange
18 Red
18 Red

It is indeed copying every 6th line. I just can't figure out how to make it start at row 1, instead of row 6.



<tbody>
</tbody>
 
Upvote 0
jsherst said:
It is indeed copying every 6th line. I just can't figure out how to make it start at row 1, instead of row 6.
Click to expand...
When we get the correct code, it will start from the bottom, not the top, which is why I asked the final question in post #4. Could you please answer that question?
 
Upvote 0
I am a little confused on the question but if starting at 13 it would need to copy "13, 7, 1"

I hope I am answering your question correctly.

The actual list is 1573 rows. That is one of many excel lists with sizes ranging from 500 to around 10000.
 
Upvote 0
Sub addrows()

Finalrow = Cells(Rows.Count, 1).End(xlUp).Row
'work out your startrow

For x = 6 To Finalrow 'my startrow was 6
Cells(x, 1).Copy
x = x + 1
Cells(x, 1).Insert
x = x + 5
Next x

End Sub
 
Upvote 0
jsherst said:
I am a little confused on the question but if starting at 13 it would need to copy "13, 7, 1"
Click to expand...
Thanks. Try this in a copy of your workbook.

Rich (BB code): 
Sub insertrows()
  Dim StartRow As Long, r As Long
   
  Const MyColumn As String = "A"  '<- Column of interest
  Const Gap As Long = 6           '<- Row multiple to repeat
  
  StartRow = Cells(Rows.Count, MyColumn).End(xlUp).Row
  StartRow = StartRow - StartRow Mod Gap + 1
  Application.ScreenUpdating = False
  For r = StartRow To 1 Step -Gap
    Rows(r).Copy
    Rows(r).Insert
  Next r
  Application.CutCopyMode = False
  Application.ScreenUpdating = True
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Question
Formula to count duplicate Values every x # of rows
Replies
8
Views
260
Fluff
Fluff
Q
  • Solved
VBA Macro to Find Missing and Duplicate Data
2 3
Replies
20
Views
813
kevin9999
K
D
  • Question
Create Chart
Replies
0
Views
129
Danny54
D
T
  • Question
VBA/Macro Copy N Times N=Days in Dateformat
Replies
3
Views
163
Peter_SSs
Peter_SSs
C
  • Question
Inserting rows when value's are input into cells
Replies
0
Views
543
cdude911
C

Forum statistics

Threads
1,214,641
Messages
6,120,693
Members
448,979
Latest member
DET4492

Share this page

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