O código fornecido faz o que você deseja. Eu não esperava que durasse tanto, desculpe por isso. Mas acho que isso é bem eficiente. Desculpe por nenhum comentário, mas eu acidentalmente passei mais tempo nisso que eu esperava. Então, para você, isso pode ser difícil de entender o código. De qualquer forma, perguntas são bem vindas.
Essencialmente, você é solicitado a selecionar a primeira tabela e, em seguida, a segunda (não importa em qual planilha). Em seguida, o código rastreia os valores x de uma coluna na primeira tabela e grava nomes que possuem x nessa coluna em uma coisa chamada "dicionário". Então é hora da segunda tabela - se houver um x ao lado de algum nome, o valor no dicionário desse nome será alterado para 1 . Em seguida, todos os nomes que possuem o valor 1 no dicionário são colocados na string str e essa sequência é enviada para a matriz de resultados Array3 . Esse processo é repetido para todas as colunas nas duas tabelas de entrada. Finalmente, a matriz de resultados é enviada para a planilha recém-criada.
Alt + F11 abre o VBE. Inserir > Módulo insere um novo módulo. O código deve ser colado neste módulo. Quando você tiver colado o código, você pode fechar a janela do VBE. Alt + F8 abre a lista de macros.
Sub Join_tables()
Dim ws As Worksheet
Dim Array1 As Variant
Dim Array2 As Variant
Dim Array3() As Variant
Dim dict As Object
Dim dicKey As Variant
Dim str As String
Dim j As Long, k As Long, i As Long 'counters
Array1 = Application.InputBox("Select the 1st table.", "Get List", Type:=64)
Array2 = Application.InputBox("Select the 2nd table.", "Get List", Type:=64)
ReDim Array3(1 To UBound(Array1, 2), 1 To UBound(Array2, 2))
Set dict = CreateObject("Scripting.Dictionary")
For j = 2 To UBound(Array3, 1)
Array3(j, 1) = Array1(1, j)
For k = 2 To UBound(Array3, 2)
If Array3(1, k) = vbNullString Then Array3(1, k) = Array2(1, k)
For i = 2 To UBound(Array1, 1)
If Array1(i, j) = "x" Then
On Error Resume Next
dict.Add Array1(i, 1), 0
On Error GoTo 0
If Err.Number = 457 Then Err.Clear
End If
Next
For i = 2 To UBound(Array2, 1)
If Array2(i, k) = "x" Then
If dict.exists(Array2(i, 1)) Then
dict.Item(Array2(i, 1)) = 1
End If
End If
Next
str = vbNullString
For Each dicKey In dict.keys
If dict.Item(dicKey) = 1 Then
str = str & dicKey & ", "
End If
Next
dict.RemoveAll
If str <> vbNullString Then str = Left(str, Len(str) - 2)
Array3(j, k) = str
Next 'k
Next 'j
Set ws = Worksheets.Add(After:=Worksheets(Worksheets.Count))
ws.Range("A1").Resize(UBound(Array3, 1), UBound(Array3, 2)) = Array3
Set ws = Nothing
Set dict = Nothing
End Sub