XL 2016 Recherche multiple et placement dans une ListBox

Dim f, BD(), choix(), Rng
Private Sub UserForm_Initialize()
   Set f = Sheets("Feuil1")
   Set Rng = f.Range("A2:B" & f.[A65000].End(xlUp).Row)
   BD = Rng.Value
   Set d = CreateObject("scripting.dictionary")
   For i = 1 To UBound(BD)
     d(BD(i, 2)) = ""
   Next i
   choix = d.keys
   Me.ListBox1.List = d.keys
End Sub

Private Sub TextBox1_Change()
   mots = Split(Trim(Me.TextBox1), " ")
   Tbl = choix
   For i = LBound(mots) To UBound(mots)
       Tbl = Filter(Tbl, mots(i), True, vbTextCompare)
   Next i
   Me.ListBox1.List = Tbl
End Sub

Private Sub ListBox1_Click()
    métier = Me.ListBox1
    Dim Tbl()
    n = 0
    For i = 1 To UBound(BD)
     If BD(i, 2) = métier Then
        n = n + 1: ReDim Preserve Tbl(1 To UBound(BD, 2), 1 To n)
        For k = 1 To UBound(BD, 2): Tbl(k, n) = BD(i, k): Next k
     End If
   Next i
   If n > 0 Then Me.ListBox2.Column = Tbl Else Me.ListBox2.Clear
End Sub