Insérer un texte par double clik

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Row = 1 Or Target.Column <> 2 Then Exit Sub
Cancel = True
If Left(Target, 8) <> ".RUPTURE" Then
  Target = ".RUPTURE chez " & Target(1, 2) & " depuis " & Date & " " & Target
  Target.Characters(1, Len(Target(1, 2)) + 32).Font.ColorIndex = 3
Else
  Target = Mid(Target, InStrRev(Target, "depuis") + 18)
  Target.Font.ColorIndex = xlAutomatic
End If
End Sub