Hi Robert,

You need to set r=17 at the beginning of the sub and at the end.

Sub CopyMyCells1()
Dim r, c As Integer
r = 17
c = 1

Do Until Cells(r, c) = ""

Do Until Cells(r, c) = ""
r = r + 1
Loop
Cells(r - 6, c).Select
Range(Cells(r - 6, c), Cells(r - 1, c + 3)).Copy
Cells(r, c).Select
ActiveSheet.Paste
Application.CutCopyMode = False
c = c + 4
r = 17
Loop

End Sub



------------------------------------------------
~~ Message posted from http://www.ExcelTip.com/
~~ View and post usenet messages directly from http://www.ExcelForum.com/