Sub test()
Dim i&, J&
Dim D As Object, TData As Variant
Dim Tmp As Variant, TReport As Variant, K As Variant
Set D = CreateObject("scripting.dictionary")
With Sheets("Feuil1")
TData = .Range("$B$3:$B" & .Cells(.Rows.Count, "B").End(3).Row)
End With
For i = LBound(TData, 1) To UBound(TData, 1)
Tmp = Split(TData(i, 1), " ")
For J = LBound(Tmp) To UBound(Tmp)
D(Tmp(J)) = D(Tmp(J)) + 1
Next J
Next i
i = 0
ReDim TReport(1 To D.Count, 1 To 2)
For Each K In D.Keys
i = i + 1
TReport(i, 1) = K
TReport(i, 2) = D(K)
Next K
Sheets("Feuil1").Range("$G$2").Resize(D.Count, 2) = TReport
End Sub