Rows to colums

I have a sheet with products and information regarding these products.
It is consistently build up in a 5-row information block per product like:

A1: name
A2: info
A3: price
A4: to be deleted
A5: to be deleted

What I want:

A1: name
B1: description
C1: Price

For product 2 it should:
A6 -> A2
A7 -> B2
A8 -> C2
A9 -> to be deleted
A10 -> to be deleted ..etcetera

The Macro should loop until no data is found in the A column. Note: some of the 2nd rows (information) are not filled. They can't be deleted but need to be left empty!

Any chance?


Edit: Recording a macro for the first 2 products gives this:

Selection.Cut
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(1, -1).Range("A1").Select
    Selection.Cut
    ActiveCell.Offset(-1, 2).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(2, -2).Range("A1").Select
    Selection.Cut
    ActiveCell.Offset(-2, 3).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(5, -3).Range("A1").Select
    Selection.Cut
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(1, -1).Range("A1").Select
    Selection.Cut
    ActiveCell.Offset(-1, 2).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(2, -2).Range("A1").Select
    Selection.Cut
    ActiveCell.Offset(-2, 3).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(5, -3).Range("A1").Select
End Sub

Only I want it to continue throughout the whole document....