table1

Sub main()
Dim cell As Range, myCollection As New Collection, el As Variant, x As Range, c As Range, b As Range, num As Range
Dim clmn As Integer
Range("A1:A9").Select
On Error Resume Next
For Each cell In Selection
k = k + 1
myCollection.Add CStr(cell.Value), CStr(cell.Value)
Next cell
On Error GoTo 0

Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "Uni"
For Each el In myCollection
    i = i + 1
    Cells(i, 1) = el
Next el

For Each c In Worksheets(1).Range("A1:A9")
    For Each cell In Worksheets(2).Range("A1:A" & WorksheetFunction.CountA(Range("A:A")))
        If cell.Value = c.Value Then
            clmn = 1
            Do While Cells(cell.Row, c.Column + clmn) <> ""
                clmn = clmn + 1
            Loop
            roww = c.Row
            ThisWorkbook.Sheets("Uni").Cells(cell.Row, c.Column + clmn) = roww
        End If
    Next cell
Next c
End Sub