Comment faire pour bloquer une date aujourd hui

Private Sub Worksheet_Change(ByVal Target As Range)
Dim plage As Range
If Target.Count > 1 Then Exit Sub
Set plage = Union(Range("K2"), Range("B10"), Range("E10"))
If Not Intersect(plage, Target) Is Nothing Then
  Range("A2").Value = Date
  Range("A2").NumberFormat = "dd/mm/yyyy"
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Range("K2"), Target) Is Nothing Then
  If Target.Value = "" Then Exit Sub
  Range("A2").Value = Date
  Range("A2").NumberFormat = "dd/mm/yyyy"
End If
End Sub

If Not Intersect(Range("K2"), Target) Is Nothing Then
  If Target.Value = "" Then Exit Sub
  Application.EnableEvents = False
  Range("A2").Value = Date
  Range("A2").NumberFormat = "dd/mm/yyyy"
  Application.EnableEvents = True
End If

adDC = Cells(2, Columns.Count).End(xlToLeft).Address

If Not Intersect(Columns("K"), Target) Is Nothing Then
  If Target.Value = "" Then Exit Sub
  Range("A" & Target.Row).Value = Date
  Range("A" & Target.Row).NumberFormat = "dd/mm/yyyy"
End If

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Union(Range("$K$2"), Range("B10"), Range("E10"))) Is Nothing Then
Range("E2").Value = Format(Date)
End If
End Sub

Const Nom_Col As String = "certifié"

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Plage As Range

    If Target.Count > 1 Then Exit Sub 'si on modifie plusieurs cellules simultanément
    adDC = Cells(2, Columns.Count).End(xlToLeft).Address
    LDCol = Split(adDC, "$")(1)    'lettre derniere colonne ligne 2
    NDCol = Range(Split(adDC, "$")(1) & 1).Column   'derniere colonne en nombre
    Set Plage = Range("A2:" & LDCol & 2)     'plage de colonnes ligne 2
    LCol = Chr(Plage.Find(Nom_Col, lookat:=xlWhole).Column + 64) 'lettre colonne "certifié"
    If Application.CountIf(Plage, Nom_Col) > 0 Then 'existe
        If Not Intersect(Target, Range(LCol & "2:" & LCol & "50")) Is Nothing Then 'plage à adapter
            If UCase(Target) = "NON" Then
                nouvlig = Sheets("Archives signataires").Cells(Rows.Count, 1).End(xlUp).Row + 1 'index de la première ligne vide dans "Archives"
                Cells(Target.Row, 1).Resize(1, NDCol).Copy
                Sheets("Archives signataires").Cells(nouvlig, 1).Resize(1, NDCol).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                Application.EnableEvents = False 'désactiver les événements
                Cells(Target.Row, 1).EntireRow.Delete
                Application.EnableEvents = True
            End If
        End If
    Else
        MsgBox "Attention: " & Nom_Col & " n'extiste pas !!!!!!!"
    End If
    Set Plage = Nothing
End Sub