Try
Sub test()
Dim a, i As Long, ii As Long, w, x As Object, n As Long
With Range("a1", Cells.SpecialCells(11))
    a = .Value
    .ClearContents
    With CreateObject("System.Collections.SortedList")
        For i = 1 To UBound(a, 1)
            If Not IsEmpty(a(i, 1)) Then
                If Not .Contains(a(i, 1)) Then
                    ReDim w(1 To UBound(a, 2), 1 To 1)
                Else
                    w = .Item(a(i, 1))
                    ReDim Preserve w(1 To UBound(w, 1), 1 To UBound(w, 2) + 1)
                End If
                For ii = 1 To UBound(a, 2)
                    w(ii, UBound(w, 2)) = a(i, ii)
                Next
                .Item(a(i, 1)) = w
            End If
        Next
        Set x = .Clone
    End With
    With .Cells(1)
        For i = 0 To x.Count - 1
            w = x.GetByIndex(i)
            .Offset(n).Resize(UBound(w, 2), UBound(a, 2)).Value = _
            Application.Transpose(w)
            n = n + UBound(w, 2) + 1
        Next
    End With
End With
Set x = Nothing
End Sub