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