creer un champ de recherche

'En entête du formulaire
Dim WsS As Worksheet, ListOb As ListObject, ctrl As Control, num As Long, DL As Long

    'Dans UserForm_Initialize
    Set WsS = Sheets("SOURCE")
    Set ListOb = WsB.ListObjects("Tab_1")
   

    'Dans la macro d'enregistrement
    DL = WsS.Range("a" & Rows.Count).End(xlUp).Row + 1
    ListOb.ListRows.Add

    With WsS
            'Création de la Matricule
             .Range("a" & DL) = Left(txt_prenom, 3) & "-" &  1228 + DL
             .Range("b" & DL) = xxxxxxxx
            etc.
    End With

    With ListOb
        .Sort.SortFields.Clear
        .Sort.SortFields.Add _
        Key:=Range("Tab_1[Nom]"), SortOn:=xlSortOnValues, _
        Order:=xlAscending, DataOption:=xlSortNormal
        .Sort.Header = xlYes
        .Sort.Apply
    End With

    'Pour éffacer les TextBox et ComboBox
    For Each ctrl In Me.Controls
    If TypeOf ctrl Is MSForms.TextBox Or TypeOf ctrl Is MSForms.ComboBox Then ctrl = ""
    Next ctrl

Option Compare Text
Dim TBlBD(), Tbl()
Private Sub UserForm_Initialize()
  TBlBD = [tableau1].Value        ' pour rapidité
  Me.ListBox1.List = TBlBD
  Me.ListBox1.ColumnCount = [tableau1].Columns.Count
  Me.ListBox1.ColumnWidths = "30;50;50;50;50;50;50;50;50;50;50"
  '------------------------ Alimentation ComboBox
  Set d = CreateObject("scripting.dictionary")
  d("*") = ""
  For i = 1 To UBound(TBlBD)
    d(TBlBD(i, 4)) = ""
  Next i
  temp = d.keys
  'Tri temp, LBound(temp), UBound(temp)
  Me.ComboBox1.List = temp
  Me.ComboBox1 = "*"
End Sub

Private Sub ComboBox1_click()
  NbLignes = Application.CountIf([Tableau1[Classe]], Me.ComboBox1)
  ColRecherche = 4
  clé = Me.ComboBox1: n = 0
  ReDim Tbl(1 To NbLignes, 1 To UBound(TBlBD, 2))
  For i = 1 To UBound(TBlBD)
    If TBlBD(i, ColRecherche) Like clé Then
        n = n + 1
        For k = 1 To UBound(TBlBD, 2): Tbl(n, k) = TBlBD(i, k): Next k
     End If
  Next i
  Me.TextBoxRech = ""
  If n > 0 Then Me.ListBox1.List = Tbl Else Me.ListBox1.Clear
End Sub

Private Sub TextBoxRech_Change()
  Dim b()
  If Me.TextBoxRech <> "" Then
   Set d1 = CreateObject("Scripting.Dictionary")
   tmp = Me.TextBoxRech & "*"
   n = 0
   For i = 1 To UBound(Tbl)
      If Tbl(i, 2) Like tmp Then
        n = n + 1: ReDim Preserve b(1 To UBound(Tbl, 2), 1 To n)
        For k = 1 To UBound(Tbl, 2): b(k, n) = Tbl(i, k): Next k
     End If
   Next i
   If n > 0 Then Me.ListBox1.Column = b Else Me.ListBox1.Clear
Else
   Me.ListBox1.List = Tbl
End If
End Sub