See if this is what you wanted

Sub test()
    Dim ws As Worksheet, a, i As Long, ii As Long, maxCol As Long, w, x
    For Each ws In Worksheets
        With ws.Range("a1").CurrentRegion
            a = .Value
            If IsArray(a) Then
            x = UBound(a, 2)
                ReDim Preserve a(1 To UBound(a, 1), 1 To 100)
                With CreateObject("Scripting.Dictionary")
                    .CompareMode = 1
                    For i = 2 To UBound(a, 1)
                        If Not .exists(a(i, 1)) Then
                            .Item(a(i, 1)) = VBA.Array(i, x)
                        Else
                            w = .Item(a(i, 1))
                            w(1) = w(1) + 1
                            If w(1) + x > UBound(a, 2) Then
                                ReDim Preserve _
                                a(1 To UBound(a, 1), 1 To UBound(a, 2) + 100)
                            End If
                            For ii = 2 To x
                                a(w(0), w(1) + ii - 2) = a(i, ii)
                                a(i, ii) = Empty
                            Next
                            .Item(a(i, 1)) = w
                            maxCol = Application.Max(maxCol, w(1) + x)
                        End If
                    Next
                End With
                If maxCol > 0 Then
                    .Resize(, maxCol).Value = a
                End If
            End If
        End With
    Next
End Sub