Sub Découpe()
Dim Mot As String, Phrase As String
Dim FinB As Long, FinC As Long
Dim Tourne As Long, Espace As Long, Trouve As Long
Dim Cherche As Range
FinB = Range("B" & Rows.Count).End(xlUp).Row
For Tourne = 3 To FinB
Phrase = Range("b" & Tourne) & " "
Espace = 0
Trouve = 1
Do
Trouve = InStr(Trouve, Phrase, " ") + 1
Mot = LCase(Split(Phrase, " ")(Espace))
Set Cherche = Range("C:C").Find(Mot, lookat:=xlWhole)
If Cherche Is Nothing Then
Range("C" & Range("C" & Rows.Count).End(xlUp).Row + 1) = LCase(Mot)
Range("D" & Range("C" & Rows.Count).End(xlUp).Row) = 1
Else
Range("C" & Cherche.Row) = LCase(Mot)
Range("D" & Cherche.Row) = Range("D" & Cherche.Row) + 1
End If
Espace = Espace + 1
Loop Until InStr(Trouve, Phrase, " ") = 0
Next Tourne
End Sub