Sub test2()
Chaine = Range("A1") 'on récupère la chaine à traiter
For i = 1 To Len(Chaine) 'pour chaque caractère de la chaine
If Mid(Chaine, i, 1) = " " And Mid(Chaine, i + 1, 1) = " " Then 'si le caractère i ET le caractère sont des espaces
j = i
While Mid(Chaine, j, 1) = " " 'on continue de parcourir jusqu'à trouver le dernier espace de la série
j = j + 1
Wend
Chaine= Replace(Chaine, Mid(Chaine, i, j - i), Chr(10)) 'on remplace toute la série par un retour chariot
End If
Next i
Range("B1") = Chaine
End Sub