Option Compare Text 'la casse est ignorée
Private Sub TextBox1_Change()
Dim P As Range, tablo(), x$, j%, i&, n&, coul As Range, a$()
Set P = [A1].CurrentRegion.Resize(, 6).Offset(1)
tablo = P 'matrice, plus rapide
Application.ScreenUpdating = False
Intersect(P, [B:B,D:D,F:F]).Interior.ColorIndex = xlNone
ListBox1.Clear
If TextBox1 = "" Then Exit Sub
x = "*" & TextBox1 & "*"
For j = 2 To 6 Step 2
For i = 1 To P.Rows.Count - 1
If tablo(i, j) Like x Then
n = n + 1
Set coul = Union(IIf(coul Is Nothing, P(i, j), coul), P(i, j))
If n Mod 50 = 0 Then coul.Interior.ColorIndex = 43: Set coul = Nothing 'décharge toutes les 50 cellules
ReDim Preserve a(1 To n)
a(n) = tablo(i, j)
End If
Next i, j
If Not coul Is Nothing Then coul.Interior.ColorIndex = 43 'ce qui reste à colorer
If n Then ListBox1.List = a
End Sub