Autres [RÉSOLU] Peut-on arriver à "schunter" la difficulté que j'ai crée moi-même?

Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Range("A3:A500"), Target) Is Nothing Then
    Target = Application.Proper(Format(Target, "dddd dd mmm yyyy"))
End If
End Sub

Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Range("A3:A500"), Target) Is Nothing Then
    Target = Application.Proper(Format(Target, "dddd dd mmmm yyyy"))
End If
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    DerLig = Range("A" & Rows.Count).End(xlUp).Row
    If DerLig < 3 Then DerLig = 3
    If Not Intersect(Range("A3:A" & DerLig + 1), Target) Is Nothing Then
        Cancel = True
        Application.EnableEvents = False
        If IsEmpty(Target) And Application.WorksheetFunction.CountIf(Range("A2:A" & DerLig), Format(Date, "dddd dd mmmm yyyy")) > 0 Then
            MsgBox "Cette date existe déjà"
            GoTo Sortie
        End If
        If Target <> "" And Not IsError(Application.Match(CSng(Date), Columns("G"), 0)) Then    'Normalement c'est cette ligne qui est la bonne pour indiquer la date du jour
'        If Target <> "" And Not IsError(Application.Match(CSng(CDate(Trim(Mid(Target, InStr(Target, " "))))), Columns("G"), 0)) Then   'cette ligne en commentaire
            If Target.Value <> "" Then
                If MsgBox("Effacer la date?", vbYesNo) = vbYes Then
                    On Error Resume Next
                    Target.Resize(, 8).SpecialCells(xlCellTypeConstants, 23).ClearContents
                    On Error GoTo 0
                    Target.Resize(, 8).Interior.ColorIndex = 8
                End If
            End If
          Else
            Target.Offset(, 6).Value = Date
            Target = Application.Proper(Format(Date, "dddd dd mmmm yyyy"))
          End If
    End If
Sortie:
    Application.EnableEvents = True
    Range("A1").Select
End Sub

       '*****************************************************************************
    If (Target <> "" And Not IsError(Application.Match(CSng(Date), Columns("G"), 0))) Or Target <> "" And Target.Value <> Date Then
        If Target.Value <> "" Then
                On Error Resume Next
                Target.Resize(, 8).SpecialCells(xlCellTypeConstants, 23).ClearContents
                On Error GoTo 0
                Target.Resize(, 8).Interior.ColorIndex = 8
                GoTo Sortie
        End If
        Else
       '*****************************************************************************

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect(Range("H3:H500"), Target) Is Nothing Then
  UsfInfos.Show 0
  End If
End Sub