Guru do Excel e Power BI

Sub AleVBA_664() 
    Dim a, b(), i As Long, n As Long, w(), maxCol As Integer 
    With Range("a1").CurrentRegion.Resize(,2) 
        a = .Value 
        .ClearContents 
    End With 
    Redim b(1 To UBound(a,1), 1 To UBound(a,1) * UBound(a,2)) 
    With CreateObject("Scripting.Dictionary") 
        For i = 1 To UBound(a,1) 
            If Not .exists(a(i,1)) Then 
                n = n + 1 : b(n,1) = a(i,1) : .add a(i,1), Array(n,2) 
            End If 
            w = .item(a(i,1)) 
            b(w(0),w(1)) = a(i,2) 
            w(1) = w(1) + 1 
            .item(a(i,1)) = w 
            maxCol = WorksheetFunction.Max(maxCol, w(1)) 
        Next 
    End With 
    Range("a1").Resize(n, maxCol).Value = b 
End Sub