Convert from one long colum, to multiple columns

I n开发者_开发知识库eed a little help, or a VBA script that can convert a big dataset (960000 rows) in the format like below. All the data are in one column

TRIP_ID | OBJECTID | CPR_VEJNAV | ADM_VEJSTA | ADM_VEJKLA | vejid | vejkl | Shape_Length
2626    |  value   |  value     | value      | value      | value | value | value
..
..
2626    | value   |  value     | value      | value      | value | value | value
64646   | value   |  value     | value      | value      | value | value | value
..
..
..
64646   | value   |  value     | value      | value      | value | value | value

I would like to convert the data into multiple columns, one column for each TRIP_ID, like this:

TRIP_ID | .....     | TRIP_ID .....  | And so on
2626    | .....     | 64646   ..... 
..
..
2626    | ......    |  64646      .....

And so on, I have around 1800 TRIP_ID's In short terms: Convert from one long column, to multiple columns based on TRIP_ID

Always make a backup of your data before running someone else's code

Sub SplitToColumns()

    Dim rCell As Range
    Dim sCurrent As String
    Dim rLast As Range
    Dim lRowStart As Long

    Application.EnableEvents = False

    Set rLast = Sheet1.Range("A2").End(xlDown).Offset(1, 0)
    rLast.Value = "End"

    For Each rCell In Sheet1.Range("A2", rLast).Cells
        If Split(rCell.Value, "|")(0) <> sCurrent Then
            If lRowStart > 1 Then
                rCell.Offset(lRowStart - rCell.Row, 0).Resize(rCell.Row - lRowStart, 1).Copy
                Sheet1.Cells(2, Sheet1.Columns.Count).End(xlToLeft).Offset(0, 1).Resize(rCell.Row - lRowStart, 1).PasteSpecial xlValues
            End If
            lRowStart = rCell.Row
            sCurrent = Split(rCell.Value, "|")(0)
        End If
    Next rCell

    rLast.ClearContents
    Application.CutCopyMode = False
    Application.EnableEvents = True

End Sub