Microsoft 365 Comment remplacer des espaces en trop par un retour à la ligne ? (avec une formule)

=SUBSTITUE($A$4;"  ";"")

Sub TestRetourLigne()
    xCpt = 0
    xChaine = [A4]
    xDecoupe = Split(xChaine, "  ")
    For F = 0 To UBound(xDecoupe)
        If xDecoupe(F) <> Empty Then
            xCpt = xCpt + 1
            If xCpt = 1 Then
                xResult = xResult & xDecoupe(F)
            Else
                xResult = xResult & Chr(10) & LTrim(xDecoupe(F))
            End If
        End If
    Next F
    [D4] = xResult
End Sub

Sub test2()
tabvaleur = Range("A2:A3").Value 'on récupère les données à traiter
For num = LBound(tabvaleur, 1) To UBound(tabvaleur, 1) 'pour chaque donnée
    valeur = tabvaleur(num, 1) 'on initialise la "valeur"
    
    For i = 1 To Len(valeur) 'pour chaque caractère
        If Mid(valeur, i, 1) = " " And Mid(valeur, i + 1, 1) = " " Then 'si le caractère et son suivant sont des espaces
            j = i 'on note l'indice du premier espace
            While Mid(valeur, j, 1) = " " 'on parcourt les caractères suivants tant qu'il s'agit d'un espace
                j = j + 1
            Wend
            valeur = Replace(valeur, Mid(valeur, i, j - i), Chr(10), 1, 1) 'on remplace la suite d'espace qu'on vient d'identifier. et SEULEMENT cette suite
        End If
    Next i
    tabvaleur(num, 1) = valeur 'on met à jour le tableau avec la valeur modifiée
Next num
Range("B2").Resize(UBound(tabvaleur, 1), UBound(tabvaleur, 2)) = tabvaleur 'on colle le résultat en colonne B
End Sub

Sub TestRetourLigne()
    xCpt = 0
    xChaine = [A4]
    xDecoupe = Split(xChaine, "   ")    '3 espaces
    For F = 0 To UBound(xDecoupe)
        If xDecoupe(F) <> Empty Then
            xCpt = xCpt + 1
            If xCpt = 1 Then
                xResult = xResult & xDecoupe(F)
            Else
                xResult = xResult & Chr(10) & LTrim(xDecoupe(F))
            End If
        End If
    Next F
    [D4] = xResult
End Sub

Function TestRetourLigne(xCell)
    xCpt = 0
    xChaine = xCell
    xDecoupe = Split(xChaine, "   ")    '3 espaces
    For F = 0 To UBound(xDecoupe)
        If xDecoupe(F) <> Empty Then
            xCpt = xCpt + 1
            If xCpt = 1 Then
                xResult = xResult & xDecoupe(F)
            Else
                xResult = xResult & Chr(10) & LTrim(xDecoupe(F))
            End If
        End If
    Next F
    TestRetourLigne = xResult
End Function