Accélération macro VBA

Bonjour,

Je vous envoie un message pour vous demander une aide.
Actuellement j'ai créer une barre de recherche sur plusieurs colonne, le but c'est que les noms soit surligné dès que j’écris une lettre dans la barre de recherche avec une liste en dessous.
Le problème c’est que malgré qu'elle fonctionne, elle est extrêmement lente ( si je met un a dans la barre de recherche j'en ai pour 30 seconde d’exécution)
J'espère avoir été claire, voici la macro:

Private Sub TextBox1_Change() 'www.blog-excel.com/creer-un-champ-de-recherche-vba

Application.ScreenUpdating = False

Range("B4:B40").Interior.ColorIndex = 2 'Exemple 1 (feuille)
Range("D10:D40").Interior.ColorIndex = 2 'Exemple 1 (feuille)
Range("E10:E40").Interior.ColorIndex = 2 'Exemple 1 (feuille)
Range("F10:F40").Interior.ColorIndex = 2 'Exemple 1 (feuille)
Range("G4:G40").Interior.ColorIndex = 2 'Exemple 1 (feuille)
Range("H4:H40").Interior.ColorIndex = 2 'Exemple 1 (feuille)

ListBox1.Clear 'Exemple 2 (ListBox)

If TextBox1 <> "" Then
For ligne = 4 To 40
If Cells(ligne, 2) Like "*" & TextBox1 & "*" Then
Cells(ligne, 2).Interior.ColorIndex = 39 'Exemple 1 (feuille)
ListBox1.AddItem Cells(ligne, 2) 'Exemple 2 (ListBox)
End If
Next
End If

If TextBox1 <> "" Then
For ligne = 10 To 40
If Cells(ligne, 4) Like "*" & TextBox1 & "*" Then
Cells(ligne, 4).Interior.ColorIndex = 39 'Exemple 1 (feuille)
ListBox1.AddItem Cells(ligne, 4) 'Exemple 2 (ListBox)
End If
Next
End If

If TextBox1 <> "" Then
For ligne = 10 To 40
If Cells(ligne, 5) Like "*" & TextBox1 & "*" Then
Cells(ligne, 5).Interior.ColorIndex = 39 'Exemple 1 (feuille)
ListBox1.AddItem Cells(ligne, 5) 'Exemple 2 (ListBox)
End If
Next
End If

If TextBox1 <> "" Then
For ligne = 10 To 40
If Cells(ligne, 6) Like "*" & TextBox1 & "*" Then
Cells(ligne, 6).Interior.ColorIndex = 39 'Exemple 1 (feuille)
ListBox1.AddItem Cells(ligne, 6) 'Exemple 2 (ListBox)
End If
Next
End If

If TextBox1 <> "" Then
For ligne = 4 To 40
If Cells(ligne, 7) Like "*" & TextBox1 & "*" Then
Cells(ligne, 7).Interior.ColorIndex = 39 'Exemple 1 (feuille)
ListBox1.AddItem Cells(ligne, 7) 'Exemple 2 (ListBox)
End If
Next
End If

If TextBox1 <> "" Then
For ligne = 4 To 40
If Cells(ligne, 8) Like "*" & TextBox1 & "*" Then
Cells(ligne, 8).Interior.ColorIndex = 39 'Exemple 1 (feuille)
ListBox1.AddItem Cells(ligne, 8) 'Exemple 2 (ListBox)
End If
Next
End If

End Sub

La barre de recherche n'est pas une macro de moi mais d'un autre site.
Merci beaucoup pour votre aide.