supprimer une partie d'une chaine de caractères

CLIENT RDV#à dijon 
5h00#Christophe##Fred 1#journée

Function ALLEGE$(txt$)
Dim p1%, p2%, p3%
p1 = InStr(txt, "RDV")
p2 = InStr(txt, vbLf) 'position du saut de ligne
For p3 = Len(txt) To 1 Step -1 'position du dernier chiffre
  If IsNumeric(Mid(txt, p3, 1)) Then Exit For
Next
For p3 = p3 To 1 Step -1 'position du début du nombre
  If Not IsNumeric(Mid(txt, p3, 1)) Then p3 = p3 + 1: Exit For
Next
ALLEGE = Left(txt, p1 - 1) & Mid(txt, p1 + 5, p2 - p1 - 4) & Mid(txt, p3)
ALLEGE = Application.Trim(ALLEGE) 'SUPPRESPACE
End Function

Private Sub Workbook_Open()
Dim dat As Range, cel As Range
Feuil1.Activate 'CodeName de la feuille
On Error Resume Next 'si pas de cellules
For Each dat In [A:A].SpecialCells(xlCellTypeConstants, 1)
  If Date > dat + 7 Then
    For Each cel In dat.EntireRow.SpecialCells(xlCellTypeConstants, 2)
      cel = ALLEGE(cel.Text)
    Next
  End If
Next
End Sub

Private Sub Workbook_Open()
Dim dat As Range, cel As Range, flag As Boolean
Feuil1.Activate 'CodeName de la feuille
On Error Resume Next 'si pas de cellules
For Each dat In [A:A].SpecialCells(xlCellTypeConstants, 1)
  If Date > dat + 7 Then
    For Each cel In dat.EntireRow.SpecialCells(xlCellTypeConstants, 2)
      If InStr(cel, "RDV") Then cel = ALLEGE(cel.Text): flag = True
    Next
  End If
Next
If Not flag Then Me.Saved = True 'évite l'invite à la fermeture
End Sub

CLIENT#RDV à#Dijon 
#5h00 Christophe Fred#1 journée

Function ALLEGE$(txt$)
Dim p1%, p2%
1 p1 = InStr(txt, Chr(160)) 'position du 1er
If p1 Then
  p2 = InStr(p1 + 1, txt, Chr(160)) 'position du 2ème
  txt = Application.Replace(txt, p1, p2 - p1 + 1, " ") 'fonction REMPLACER
  GoTo 1
End If
ALLEGE = Application.Trim(txt) 'SUPPRESPACE
End Function