XL 2019 Retirer un mot dans un pavé de cellules contenant des Vblf

Function NettoyerTexteComplet(ByVal Texte As String, ws As Worksheet) As String
    Dim i As Integer
    Dim CharCode As Integer
    Dim TexteNettoye As String
    
    TexteNettoye = Texte
    
    ' Remplacer le mot à supprimer par un espace unique
    TexteNettoye = Replace(TexteNettoye, ws.Range("B4").Value, " ")

    ' Remplacer les caractères spéciaux par des espaces
    TexteNettoye = Replace(TexteNettoye, vbLf, " ")
    TexteNettoye = Replace(TexteNettoye, vbCr, " ")
    TexteNettoye = Replace(TexteNettoye, vbTab, " ")

    ' Supprimer les caractères non imprimables restants
    For i = 1 To Len(TexteNettoye)
        CharCode = Asc(Mid(TexteNettoye, i, 1))
        If CharCode >= 32 And CharCode <> 127 Then
            NettoyerTexteComplet = NettoyerTexteComplet & Mid(TexteNettoye, i, 1)
        End If
    Next i
    
    ' Éliminer les espaces multiples tout en conservant les séparations naturelles
    NettoyerTexteComplet = Trim(Replace(NettoyerTexteComplet, "  ", " "))

End Function

Sub AppliquerNettoyage()
    Dim ws As Worksheet
    Dim rng As Range
    Dim cell As Range
    
    Set ws = ThisWorkbook.Sheets("Feuil1") ' À remplacer par le vrai nom
    Set rng = ws.Range("D9:D32")
    
    ' Appliquer le nettoyage à chaque cellule de la plage
    For Each cell In rng
        cell.Offset(0, 5).Value = NettoyerTexteComplet(cell.Value, ws)
    Next cell
End Sub

Private Sub CommandButton1_Click()
    Dim cel As Range, Plage As Range
    Dim Mot As String
    Set Plage = Range("D9:D33")
    Mot = [B4] 'mot à supprimer
    Application.ScreenUpdating = False
     For Each cel In Plage
        cel.Value = Replace(Replace(cel.Value, Chr(10), " "), "Jean", " ")'normalisation et remplacement  du mot"Jean"
        cel.Value = Replace(Application.Trim(cel.Value), " ", Chr(10))' reduction des espace consécutifs et remplacement des espaces restants par un saut de ligne
    Next
    Application.ScreenUpdating = True
    [A1].Select
End Sub

Private Sub CommandButton1_Click()
    Dim cel As Range, Plage As Range
    Dim Mot As String
    Set Plage = Range("D9:D33")
    Mot = [B4] 'mot à supprimer
    Application.ScreenUpdating = False
     For Each cel In Plage
        cel.Value = Replace(Replace(" " & cel.Value & " ", Chr(10), " "), " Jean ", "  ")
        cel.Value = Replace(Application.Trim(cel.Value), " ", Chr(10))
    Next
    Application.ScreenUpdating = True
    [A1].Select
End Sub

let
    Source = Excel.CurrentWorkbook(){[Name="Base"]}[Content],
    Exclus = Excel.CurrentWorkbook(){[Name="Exclu"]}[Content][Column1],
    Transform = Table.TransformColumns(Source, {{"Column1", each Text.Combine(List.RemoveItems(Text.Split(_,"#(lf)"),Exclus),"#(lf)")}})
in
    Transform

 sp = Split(Replace(vbLf & c.Value & vbLf, vbLf & Range("B3").Value & vbLf, vbLf), vbLf)

Sub Jean()
     Application.ScreenUpdating = False
     For Each c In Range("D9??33").Cells
          'choisir un des 2 lignes sp=....
          sp = Split(Replace(vbLf & c.Value & vbLf, vbLf & Range("B3").Value & vbLf, vbLf), vbLf)     'ignorer Jean-pierre, Jeanne, etc
          'sp = Split(Replace(c.Value, Range("B4").Value, ""), vbLf)
          s = ""
          For i = 0 To UBound(sp)
               If Len(sp(i)) > 0 Then s = s & vbLf & sp(i)
          Next
          c.Offset(, 6).Value = Mid(s, 2)
     Next
End Sub