Moving data from a row to column based on dup

Here you go...sorry it took so long. I really stuggle when a macro involves the moving of cells, but I think this does it.

If you want to delete all of the blanks thereby leaving just the unique company names then remove the " ' " from the code below.

I duplicated your data on Sheet2 and Sheet3 if you want to run it without the delete and then with. Hope this is what you expected.

>> To run the macro from Excel, ALT + F8 Highlight macro and select Run

Sub MoveData()
    Dim LR As Long
    Dim i As Long
    Dim j As Long: j = 4
    LR = Range("A" & Rows.Count).End(xlUp).Row
    For i = 3 To LR
        If Cells(i - 1, 1) <> Cells(i - 2, 1) Then
            Cells(i, 2).Resize(, 2).Copy Cells(i - 1, j)
            Cells(i + 1, 2).Resize(, 2).Copy Cells(i - 1, j + 2)
        End If
    Next i
    'Deletes all blank rows which do not have names leaving just one unique company name
    'Range("D:D").SpecialCells(xlCellTypeBlanks).EntireRow.Delete xlShiftUp
End Sub