data arranging

Assuming your data is sorted into groups as per your example.

Sub X()

    Dim lngRow As Long
    Dim strPreviousItem As String
    Dim lngCol As Long
    Dim lngOutRow As Long
    
    lngRow = 1
    strPreviousItem = Cells(lngRow, 1)
    Do While Len(Cells(lngRow, 1)) > 0
        If Cells(lngRow, 1) <> strPreviousItem Then
            Exit Do
        End If
        lngRow = lngRow + 1
    Loop
    lngCol = 1
    Do While Len(Cells(lngRow, 1)) > 0
        If Cells(lngRow, 1) <> strPreviousItem Then
            strPreviousItem = Cells(lngRow, 1)
            lngCol = lngCol + 2
            If Len(Cells(1, lngCol)) = 0 Then
                lngOutRow = 1
            Else
                lngOutRow = Cells(Rows.Count, lngCol).End(xlUp).Row + 1
            End If
        End If
        With Cells(lngRow, 1).Resize(1, 2)
            .Copy Cells(lngOutRow, lngCol)
            .Clear
        End With
        lngOutRow = lngOutRow + 1
        lngRow = lngRow + 1
    Loop
End Sub