Erreur programme

Bonjour à tous j'ai un programme qui permet d'afficher les mots qui reviennent le plus parmis mes données, les données sont des commentaires qui se situe sur la feuille "Donnees_brutes" du fichier client dans la colonne D et le résultat est affiché dans la feuille "Analyse" du fichier client dans la colonne i.

Lorsque je lance le programme, ça marche mais ça n'affiche rien, j'ai juste modfié un bout car je veux supprimer des mots qui sont inutile comme "et,a,à,est,etc" pour par perturber la liste de mot sauf qu'il fallait rentrer dans la macro pour le modfiier et mtn j'ai crée une mini base de donnée dans la Colonne A de la feuille "SupprimerMot" du fichier_test sous forme de liste.

Si quelqu'un à la moindre idée je suis preneur

Sub rechercheMots(classeur)
'va stocker tous les mots et les compter
Dim dico As Scripting.Dictionary
Set dico = New Dictionary

'va rechercher les mots
Dim reg As VBScript_RegExp_55.regexp
Dim Match As VBScript_RegExp_55.Match
Dim Matches As VBScript_RegExp_55.MatchCollection

Set reg = New VBScript_RegExp_55.regexp
reg.Pattern = "[a-zA-Zéèâäù']+"
reg.Global = True

Set Matches = reg.Execute(chaine)
For Each Match In Matches
    If dico.Exists(LCase(Match)) Then
        dico.Item(LCase(Match)) = dico.Item(LCase(Match)) + 1
    Else
        dico.Add LCase(Match), 1
    End If
Next Match

'mots usuels à supprimer
[b]Dim listeMotsSupprimer As Range, rw As Long
With Workbooks("fichier_test").Sheets("SupprimerMot")
    rw = .Cells(Rows.Count, 1).End(xlUp).Row
    Set listeMotsSupprimer = .Range("A2:A" & rw)
End With[/b] ' 

For Each element In listeMotsSupprimer
    If dico.Exists(LCase(element)) Then
    dico.Remove LCase(element)
Next element

Dim tableauTop() As Variant
ReDim tableauTop(1 To 10, 1 To 2)

Dim maxOcc As Integer
Dim numElement As Integer
Dim affichage As String
Dim i As Integer
i = 6
affichage = ""

numElement = 0
maxOcc = 1
While numElement <= 10 And dico.Count > 0 And maxOcc <> 0
    maxOcc = 0
    numElement = numElement + 1
    For Each element In dico.Keys
        If dico.Item(element) > maxOcc Then
            tableauTop(numElement, 1) = element
            tableauTop(numElement, 2) = dico.Item(element)
            maxOcc = dico.Item(element)
        End If
    Next element
    If maxOcc > 0 Then
        Worksheets("Analyse").Activate
        Cells(i, 9) = affichage
        Cells(i, 9).Font.Bold = True
        Cells(i, 9).Font.ColorIndex = 2
        Cells(i, 9).Select
    With Selection.Font
        .Size = 11
    End With
    With Cells(8, 7)
        .HorizontalAlignment = xlHAlignCenter
    End With
    i = i + 1
        dico.Remove (tableauTop(numElement, 1))
        affichage = "N°" & numElement & " : " & tableauTop(numElement, 1) & " (x" & tableauTop(numElement, 2) & ")"
    End If
Wend

Set dico = Nothing

End Sub

Sub liste_mots(classeur)
Dim chaine As String
chaine = ""
Workbooks("fichier_client").Activate
Worksheets("Donnees_brutes").Activate

For Each cell In Range("D2").End(xlDown)
    chaine = chaine & " " & cell.Value
Next

rechercheMots chaine
End Sub]

Voilà ce que j'ai modifié

Dim listeMotsSupprimer As Range, rw As Long
With Workbooks("fichier_test").Sheets("SupprimerMot")
    rw = .Cells(Rows.Count, 1).End(xlUp).Row
    Set listeMotsSupprimer = .Range("A2:A" & rw)
End With[

avant il y avait Dim listeMotSupprimer as variante

listeMotSupprimer = Array("a','que",etccc)