VBA Copy then repeatedly paste

[Zakkaroo]

I have a list of Customer Numbers in Column H, going down. The list always Starts in Cell H2 but can end at any point ... H11, H23, H30 etc. I need a macro that:

1. highlights this range of Cells (however many there may be)
2. copies this selection
3. Pastes this selection 53 times starting cell C2

So as an example, lets say our customer list goes from H2 to H11. It will highlight H2 to H11, copy this data, select C2 and Paste, then it will have to move C12 and paste again, then it will have to move to C22 and paste again and so on.

But if our customer list went from cell H2 to H15, it would need to highlight that range, copy it, paste it into C2, then select C16 and paste again. Etc.

I can sort of fathom out a way of doing it, through selecting the data to the end, performing some sort of count at this point, then pasting, moving down by the count value and pasting over and over in a for loop.

But the code eludes my simple mind.

Any help much appreciated

 

[Sektor]

Sub Co()
    Range("H2:H" & Range("H2").End(xlDown).Row).Copy Range("C2:C" & Range("H2").End(xlDown).Row).Resize(, 53)
End Sub

 

[VoG]

Try

Sub atest()
Dim LR As Long, i As Long
LR = Range("H" & Rows.Count).End(xlUp).Row
Range("H2:H" & LR).Copy
For i = 1 To 53
    Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Next i
Application.CutCopyMode = False
End Sub

 

[Zakkaroo]

Try

Thanks both for the quick replies, as ever this forum comes to my rescue!

I have used Vog's solution and it's worked fantastically! Thanks Vog.

I did give yours a go Sektor, but it seemed to paste it, then move along one Column then paste again, instead of move down x rows and repaste.

Thanks for the response though, appreciate your time.

 

[Sektor]

Sub Co()
    Range("H2:H" & Range("H2").End(xlDown).Row).Copy Range("C2:C" & Range("H2").End(xlDown).Row).Resize(53 * Range("H2:H" & Range("H2").End(xlDown).Row).Rows.Count)
End Sub

 

[JackDanIce]

Sektor, your 2nd suggestion provides a run-time error

Instead, try:

Sub DuplicateMe ()

Dim i As Long, j As Long

i = Range("H" & Rows.Count).End(xlUp).Row - 1
j = i + 1
Range("H2:H" & j).Copy Range("C2:C" & j).Resize(53 * i)

End Sub

 

[Sektor]

JackDanIce, I corrected it. All works.

 

[JackDanIce]

Apologies, must have been after I saw it; ignore mine then

 

[Sektor]

JackDanIce, Ok!

 

[bigtex86]

Is there any way to target this to specific sheets? I have a very similar need, but my team member names start in A2 on sheet "District" and I need this pasted beginning in A11 on sheet "Input"