VBA Transpose Paste Loop (looping recorded Macro)

[Lbaile22]

I'm a newbie to VBA scripting. Basically I've recorded the macro shown below. I need this looped incrementally until the end of the worksheet is reached. Thanks in advance.



Sub Transpose()
'
' Transpose Macro
'
'
Range("C1:C4").Select
Selection.Copy
Range("D1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("C5:C8").Select
Application.CutCopyMode = False
Selection.Copy
Range("D5").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("C9:C12").Select
Application.CutCopyMode = False
Selection.Copy
Range("D9").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
End Sub

[offthelip]

try this:

Sub transpose2()
lastrow = Cells(Rows.Count, "C").End(xlUp).Row
For i = 1 To lastrow Step 4
Range(Cells(i, 3), Cells(i + 3, 3)).Select
Selection.Copy
Range(Cells(i, 4), Cells(i, 4)).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Next i


End Sub

[Lbaile22]

try this:

Sub transpose2()
lastrow = Cells(Rows.Count, "C").End(xlUp).Row
For i = 1 To lastrow Step 4
Range(Cells(i, 3), Cells(i + 3, 3)).Select
Selection.Copy
Range(Cells(i, 4), Cells(i, 4)).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Next i


End Sub

This worked perfectly. Thank you!