Sub ListeLesMotsDuClasseur()
Const N$ = "Résumé"
Dim F As Worksheet
Dim R As Worksheet
Dim D As Variant
Dim T As Variant
Dim M As Variant
Dim L As Long
Dim C As Long
Dim I As Integer
With ThisWorkbook
' Définir la feuille Résumé
On Error Resume Next
Set R = .Worksheets(N)
On Error GoTo 0
If R Is Nothing Then
'Si elle n'existe pas, la créer.
Set R = .Worksheets.Add(before:=.Worksheets(1))
R.Name = N
End If
' Créer la liste des mots
Set D = CreateObject("Scripting.Dictionary")
' Analyser chaque feuille ...
For Each F In .Worksheets
' ... sauf la feuille résumé
If F.Name <> N Then
' Transférer les valeurs des cellules dans un tableau sauf les titres
T = F.UsedRange.Offset(1).Value
' Analyser chaque colonne du tableau ...
For C = LBound(T, 2) To UBound(T, 2)
' ... et chaque ligne (cellule) de la colonne
For L = LBound(T, 1) To UBound(T, 1)
' Si la donnée est un texte ...
If VarType(T(L, C)) = vbString Then
' ... créer un tableau des mots de la cellule
M = Split(Replace(T(L, C), Chr(10), " "), " ")
' Analyser chaque mot
For I = UBound(M) To LBound(M)
D(M(I)) = D(M(I)) + 1
Next I
End If
Next L
Next C
End If
Next F
End With
' Mettre à jour la liste des mots
R.Columns("A:B").ClearContents
R.Range("A1").Value = "Liste des mots"
R.Range("B1").Value = "Nombre d'occurences"
R.Range("A2").Resize(D.Count) = Application.Transpose(D.Keys)
R.Range("B2").Resize(D.Count) = Application.Transpose(D.Items)
R.Columns.AutoFit
End Sub