Private Sub ListBox1_Change()
Dim r As Range, adr$, cnt&, s$, i&
s = Me.ListBox1.Value
Me.ListView1.ListItems.Clear
With Sheets("BD").Range("A1").CurrentRegion
Set r = .Find(What:=s, lookat:=xlWhole)
If Not r Is Nothing Then
adr = r.Address
Do
cnt = cnt + 1
With Me.ListView1
.ListItems.Add Text:=r.Value
For i = 2 To 6
.ListItems(cnt).ListSubItems.Add Text:=r(1, i)
Next i
End With
Set r = .FindNext(r)
Loop While r.Address <> adr
End If
End With
End Sub