Sub caractere17()
For Each texte In Range([A2], [A2].End(xlDown))
longu = Len(texte.Value) 'récupère la longueur du texte
If longu > 17 Then
'si le 18e caractère n'est pas un espace .....
If Mid(texte.Value, 18, 1) <> " " Then
'.....cherche l'espace précédent pour ne pas couper le texte
For car = 17 To 1 Step -1
If texte.Characters(car, 1).Caption = " " Then
'et écrit le résultat souhaité
texte.Offset(0, 2).Value = Left(texte.Value, car - 1)
texte.Offset(0, 3).Value = Right(texte.Value, longu - car)
Exit For
End If
Next car
End If
End If
Next texte
End Sub