Te anexo la macro
Sub BuscarDatos()
'Por.Dante Amor
tabla2 = "TABLA N°2 MARCAS.xls"
tabla3 = "TABLA N° 3 RUBROS.xls"
existe2 = False
existe3 = False
'
For Each l In Workbooks
n1 = l.Name
If LCase(l.Name) = LCase(tabla2) Then existe2 = True
If LCase(l.Name) = LCase(tabla3) Then existe3 = True
Next
If existe2 = False Then
MsgBox "Falta abrir el libro con la tabla : " & tabla2
Exit Sub
End If
If existe3 = False Then
MsgBox "Falta abrir el libro con la tabla : " & tabla3
Exit Sub
End If
'
Set l1 = ThisWorkbook
Set l2 = Workbooks(tabla2)
Set l3 = Workbooks(tabla3)
Set h1 = l1.Sheets(1)
Set h2 = l2.Sheets(1) 'marcas
Set h3 = l3.Sheets(1) 'rubros
'
u = h1.Range("B" & h1.Rows.Count).End(xlUp).Row
If u = 1 Then u = 2
h1.Range("F2:G" & u).ClearContents
'buscar datos
Call BuscarNumero(h2, h1, "F")
Call BuscarNumero(h3, h1, "G")
MsgBox "Proceso terminado", vbInformation, "BUSCAR DATOS"
End Sub
'
Sub BuscarNumero(hoja, h1, col)
'Por.Dante Amor
For i = 1 To hoja.Range("B" & hoja.Rows.Count).End(xlUp).Row
If hoja.Cells(i, "B") <> "" Then
Set r = h1.Columns("B")
Set b = r.Find(hoja.Cells(i, "B"), lookat:=xlPart)
If Not b Is Nothing Then
celda = b.Address
Do
'detalle
'h1.Cells(b.Row, col) = h1.Cells(b.Row, col) & hoja.Cells(i, "A") & ","
h1.Cells(b.Row, col) = hoja.Cells(i, "A")
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> celda
End If
End If
Next
End Sub
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias