Copy Items in row from One column sequence to separate columns

[Cyphas]

I Have data in a column like below a set of emails and associated numbers all in a sequenced flow. I want this to be transposed somewhat with their corresponding sequence on the same row in different columns. How can this be done
So, for example
John E
something@domain.com
50.
22
Margaret S
lala@anotherdom.com
2
44
...etc


In the pasted table I have done it to show.

Name 1			Name Col	Email Col	Total Col	Earn Col
Email 1			Name1	Email1	Total1	Earn1
Total1			Name2	Email2	Total2	Earn2
Earn1			Name3	Email3	Total3	Earn3
Name 2			Name4	Email4	Total4	Earn4
Email 2			Name5	Email5	Total5	Earn5
Total2
Earn2
Name 3
Email 3
Total3
Earn3
Name 4
Email 4
Total4
Earn4
Name 5
Email 5
Total5
Earn5

 

[JoeMo]

Sub ReorgData()
Dim R As Range, i As Long
Set R = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Application.ScreenUpdating = False
Range("D:G").ClearContents
Range("D1:G1").Value = Array("Name", "Email", "Total", "Earn")
For i = 1 To R.Count Step 4
    Cells(i, "A").Resize(4, 1).Copy
    Cells(Rows.Count, "D").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues, Transpose:=True
Next i
Range("D:G").EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub

 

[Cyphas]

Sub ReorgData()
Dim R As Range, i As Long
Set R = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Application.ScreenUpdating = False
Range("D:G").ClearContents
Range("D1:G1").Value = Array("Name", "Email", "Total", "Earn")
For i = 1 To R.Count Step 4
    Cells(i, "A").Resize(4, 1).Copy
    Cells(Rows.Count, "D").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues, Transpose:=True
Next i
Range("D:G").EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub

Super Awesome! Works like a charm. Thank you @JoeMo . Much appreciated. How can one repay?

Best regards
Devereaux

 

[JoeMo]

Super Awesome! Works like a charm. Thank you @JoeMo . Much appreciated. How can one repay?

Best regards
Devereaux

You are welcome - thanks for the reply. No repay sought.