Sub macro1()
Dim iCt As Long
Dim iCol As Long
Dim iRow As Long
Set ws = Sheets("Sheet1")
iCol = 2
iCt = 1
iRow = 1
Do Until ws.Cells(iCt, 1) = ""
ws.Cells(iRow, iCol) = ws.Cells(iCt, 1)
If iCt Mod 5 = 0 Then
iRow = iRow + 1
iCol = 1
End If
iCol = iCol + 1
iCt = iCt + 1
Loop
End Sub

Hth,
Merjet