Ajout texte automatique dans cellule après saisie

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 And Target(1) <> "" And Left(Target(1), 8) <> "Monsieur" Then Target(1) = "Monsieur " & Target(1)
End Sub

Sub EntrerMonsieur()
Dim t, P As Range, tablo, i&, x$
t = Timer
With ActiveSheet 'adapter éventuellement
    Set P = Intersect(.Range("A2:A" & .Rows.Count), .UsedRange)
    If P Is Nothing Then Exit Sub
    If .FilterMode Then .ShowAllData
End With
tablo = P 'matrice, plus rapide
If Not IsArray(tablo) Then tablo = P.Resize(, 2) 'au moins 2 éléments
For i = 1 To UBound(tablo)
    x = tablo(i, 1)
    If x <> "" And Left(x, 8) <> "Monsieur" Then tablo(i, 1) = "Monsieur " & x
Next
P = tablo 'restitution
MsgBox "Durée " & Format(Timer - t, "0.00 \s")
End Sub