Sub test()
    Dim z, i&,j&, m&: z = Range("A1:C" & Range("A" & Rows.Count).End(xlUp).Row).Value
    With CreateObject("scripting.dictionary"): .CompareMode = 1
    For i = 1 To UBound(z)
         If .exists(z(i, 1)) = False Then
         m = m + 1: .Item(z(i, 1)) = m: For j = 1 To UBound(z, 2): z(m, j) = z(i, j): Next
         Else
         z(.Item(z(i, 1)), UBound(z, 2)) = z(.Item(z(i, 1)), UBound(z, 2)) & ";" & z(i, UBound(z, 2))
         End If
   Next
   Range("G1").Resize(.Count, UBound(z, 2)).Value = z
   Columns("H:H").Delete
   End With
End Sub