Copy and paste list members multiple times

[KGee]

I have a series of ID's residing on one sheet that I need to copy over to a second sheet. There are currently 37 ID's starting in C14 of Sheet1 through C50 but the number will vary. I need to paste each ID into Sheet2 starting in cell D7. Each ID needs to get pasted 6x, then I need to skip a row, then paste the next ID 6x and so forth until complete. Below is a sample of the end result I want to achieve through VBA.

D7	ID01
D8	ID01
D9	ID01
D10	ID01
D11	ID01
D12	ID01
D13
D14	ID02
D15	ID02
D16	ID02
D17	ID02
D18	ID02
D19	ID02
D20
D21	ID03
D22	ID03
...	...

<tbody>
</tbody>

 

[My Aswer Is This]

Try this:

Sub Copy_Count()
'Modified 7/31/2019 11:52:55 PM  EDT
Application.ScreenUpdating = False
Dim i As Long
Dim ans As Long
ans = 7
Dim Lastrow As Long
Lastrow = Sheets(1).Cells(Rows.Count, "C").End(xlUp).Row
For i = 14 To Lastrow
    Sheets(1).Cells(i, "C").Copy Sheets(2).Cells(ans, "D").Resize(6)
    ans = ans + 6
Next
Application.ScreenUpdating = True
End Sub

 

[KGee]

Thanks so much. I had to make a slight change to account for the blank row but does exactly what I needed.

[COLOR=#333333]ans = ans + 6

[/COLOR]to

[COLOR=#333333]ans = ans + 7[/COLOR]

 

[My Aswer Is This]

Yes. I forgot about the blank row you wanted. Glad to see you know how to mody script to your needs.

Thanks so much. I had to make a slight change to account for the blank row but does exactly what I needed.

[COLOR=#333333]ans = ans + 6

[/COLOR]to

[COLOR=#333333]ans = ans + 7[/COLOR]