H o l a :
Te anexo el código para filtrar el resultado en el listbox
Private Sub CommandButton5_Click()
'Act.Por Dante Amor
On Error Resume Next
Rector.Value = WorksheetFunction.VLookup(Val(id.Value), Sheets("bd").Range("A1:g1112"), 2, False)
Celular.Value = WorksheetFunction.VLookup(Val(id.Value), Sheets("bd").Range("A1:g1112"), 3, False)
IE.Value = WorksheetFunction.VLookup(Val(id.Value), Sheets("bd").Range("A1:g1112"), 4, False)
Municipio.Value = WorksheetFunction.VLookup(Val(id.Value), Sheets("bd").Range("A1:g1112"), 5, False)
Email.Value = WorksheetFunction.VLookup(Val(id.Value), Sheets("bd").Range("A1:g1112"), 6, False)
Dir.Value = WorksheetFunction.VLookup(Val(id.Value), Sheets("bd").Range("A1:g1112"), 7, False)
On Error GoTo 0
'
'Por.Dante Amor
If TextBox21 = "" Then Exit Sub
'
Set h = Sheets("CONSOLIDADO")
Set h2 = Sheets("filtro")
h2.Cells.Clear
h.Range("L3, M3, N3, O3,U3,Z3,AB3,AD3,AF3,AG3").Copy h2.Rows(1)
Set r = h.Columns("F")
Set b = r.Find(TextBox21, lookat:=xlWhole)
j = 2
If Not b Is Nothing Then
ncell = b.Address
Do
'detalle
h2.Cells(j, "A") = h.Cells(b.Row, "L")
h2.Cells(j, "B") = h.Cells(b.Row, "M")
h2.Cells(j, "C") = h.Cells(b.Row, "N")
h2.Cells(j, "D") = h.Cells(b.Row, "O")
h2.Cells(j, "E") = h.Cells(b.Row, "U")
h2.Cells(j, "F") = h.Cells(b.Row, "Z")
h2.Cells(j, "G") = h.Cells(b.Row, "AB")
h2.Cells(j, "H") = h.Cells(b.Row, "AD")
h2.Cells(j, "I") = h.Cells(b.Row, "AF")
h2.Cells(j, "J") = h.Cells(b.Row, "AG")
j = j + 1
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> ncell
End If
ListBox1.ColumnCount = 11
ListBox1.ColumnHeads = True
u = h2.UsedRange.Rows(h2.UsedRange.Rows.Count).Row
ListBox1.RowSource = h2.Name & "!A2:J" & u
End Sub