Combine multiple rows into one row

Hi.. Badly need a help in the excel collation data. I need to combine data from multiple rows into one row in a separate sheet. My worksheet has 92,000 rows and 80 columns in this I have a a column which has a unique id but have a different values in rows and most of them are blank. I have attached the sample spread sheet for reference. Can any provide me the macro Pls.

Try this

Sub abc()
 Dim i As Long, ii As Long

 Dim a
 a = Range("a2:bc" & Cells(Rows.CountLarge, "a").End(xlUp).Row)
 With CreateObject("Scripting.Dictionary")
    .CompareMode = 1
    For i = 1 To UBound(a, 1)
        For ii = 2 To UBound(a, 2)
            If Not .Exists(a(i, 1)) Then
                .Item(a(i, 1)) = a(i, 1)
            Else
                If Not IsEmpty(a(i, ii)) Then
                    .Item(a(i, 1)) = .Item(a(i, 1)) & "," & a(i, ii)
                End If
            End If
        Next
    Next
    a = .Items
    Worksheets.Add after:=Worksheets(Worksheets.Count)
    For i = LBound(a) To UBound(a)
        s = Split(a(i), ",")
        Cells(i + 1, 1).Resize(, UBound(s) + 1) = s
    Next
        Range("a1").Resize(i, UBound(a)).Borders.LineStyle = xlContinuous
 End With
End Sub

Try this one, I believe my first code was missing the first column.

Sub abc()
 Dim i As Long, ii As Long

 Dim a
 a = Range("a2:bc" & Cells(Rows.CountLarge, "a").End(xlUp).Row)
 With CreateObject("Scripting.Dictionary")
    .CompareMode = 1
    For i = 1 To UBound(a, 1)
        For ii = 1 To UBound(a, 2)
            If Not .Exists(a(i, 1)) Then
                .Item(a(i, 1)) = a(i, 1)
            Else
                If Not IsEmpty(a(i, ii)) And ii > 1 Then
                    .Item(a(i, 1)) = .Item(a(i, 1)) & "," & a(i, ii)
                End If
            End If
        Next
    Next
    a = .Items
    Worksheets.Add after:=Worksheets(Worksheets.Count)
    For i = LBound(a) To UBound(a)
        s = Split(a(i), ",")
        Cells(i + 1, 1).Resize(, UBound(s) + 1) = s
    Next
        Range("a1").Resize(i, UBound(a) + 1).Borders.LineStyle = xlContinuous
 End With
End Sub

If your sure you have 80 columns then try

Range("a1").Resize(i, 80).Borders.LineStyle = xlContinuous

Im not sure why, you can remove that line. All it does is add the border around the data.

Could try this and see if it would work..

Range("a1").Resize(i, UBound(a, 1) + 1).Borders.LineStyle = xlContinuous