Option Explicit

Sub Perebor() 'коллекция в словаре
    Dim a, i&, ii&, t$, tt$, Dic As Object
    Dim el, col, mx&
    
    a = [a1].CurrentRegion.Value
    Set Dic = CreateObject("Scripting.Dictionary")
    With Dic
        .CompareMode = 1
        For i = 1 To UBound(a)
            t = a(i, 1)
            If Not .exists(t) Then .Add t, New Collection
            For ii = 2 To UBound(a, 2)
            tt = Trim(a(i, ii))
            If Len(tt) Then .Item(t).Add "'" & tt: mx = mx + 1
            Next
        Next
    End With
    
ReDim b(1 To mx, 1 To 2): i = 0
    For Each el In Dic.keys
        For Each col In Dic.Item(el)
        i = i + 1
        b(i, 1) = el
        b(i, 2) = col
        Next
    Next

    With Workbooks.Add.Sheets(1)
        .Cells(1, 1).Resize(UBound(b), UBound(b, 2)) = b
        .Cells.EntireColumn.AutoFit
    End With
End Sub