XL 2016 Probleme "erreur d'execution 5"

Sub filtre()
   Dim a()
  
   Ligne = 0
   For i = 1 To Bd.Rows.Count
     ok = True
     For n = 1 To Bd.Columns.Count
      If Not Bd.Cells(i, n) Like Me("Cbx" & n) Then ok = False
     Next n
     If ok Then
       Ligne = Ligne + 1
       ReDim Preserve a(1 To 5, 1 To Ligne)
       For k = 1 To Bd.Columns.Count: a(k, Ligne) = Bd.Cells(i, k): Next k
      End If
   Next i
   If Ligne = 1 Then ReDim Preserve a(1 To 5, 1 To 2)
    On Error Resume Next
        ListBox1.Clear
        ListBox1.List = Application.Transpose(a)
    On Error GoTo 0
   Me.TextBox3 = Ligne
  
End Sub

Sub ListeCol(noCol)
    
  Set MonDico = CreateObject("Scripting.Dictionary")
  For i = 1 To Bd.Rows.Count
     ok = True
     For n = 1 To Bd.Columns.Count
       If n <> noCol Then
         If Not Bd.Cells(i, n) Like Me("Cbx" & n) Then ok = False
       End If
     Next n
     If ok Then
       tmp = Bd.Cells(i, noCol)
       MonDico(tmp) = tmp
     End If
   Next i
   MonDico.Add "*", "*"
   temp = MonDico.items
   Call Tri(temp, LBound(temp), UBound(temp))
   Me("Cbx" & noCol).List = temp
   If Me("Cbx" & noCol) = "" Then Me("Cbx" & noCol) = "*"

  
End Sub