Microsoft 365 Insérer le nom utilisateur et la date du jour selon le contenu d'une cellule

'MOT DE PASSE A MODIFIER
Public Const Mdp = "Temporaire"

Sub DéVerrouillerCellsSaisie()
  'Déverrouiller les celules de saisie en début d'année
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    Dim CellDép As Range, Wsh As Worksheet
    Set Wsh = ThisWorkbook.Worksheets("BOB. FACTION A")
    Wsh.Unprotect Mdp 'on enlève la protection
    
    iDép = 5 'début de la zone ligne 5
    iFin = Wsh.Cells(Wsh.Rows.Count, 1).End(xlUp).Row + Wsh.Cells(Wsh.Rows.Count, 1).End(xlUp).MergeArea.Rows.Count - 1 'Fin de la zone
    '1 Les critères et les dates
    Set CellDép = Wsh.[H5]  'Les critères sont en colonne H
    Col = CellDép.Column
    'On recherche les cellules non fusionnées de la colonne H
    For i = iDép To iFin
        With Wsh.Cells(i, Col)
            If Not .MergeCells Then
                'On les déverrouille ainsi que les dates (2 colonnes à droite)
                .Locked = False
                .Offset(0, 2).Locked = False
            End If
        End With
    Next i
    
    '2 Les validations par le manager
    Set CellDép = Wsh.[B5] 'Les validations sont dans la colonne B
    Col = CellDép.Column
        'On recherche les cellules non fusionnées de la colonne B
        For i = iDép To iFin
        With Wsh.Cells(i, Col)
            If Not .MergeCells Then
            'On les déverrouille ainsi que les libellés (1 colonne à droite)
                .Locked = False
                .Offset(0, 1).MergeArea.Locked = False
            End If
        End With
    Next i
    Wsh.EnableSelection = xlUnlockedCells 'seules les cellules déverrouillés sont accessibles
    Wsh.Protect Mdp 'On remet la protection
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
'Lorsque qu'une modification advient ...
    
    'Cas des critères
    If Target.Count = 1 And Target.Column = 8 Then
        'S'il n'y a qu'une cellule modifiée et qu'elle est en colonne H (8)
        Application.EnableEvents = False
        'Si la cellule modifiée n'est pas vide, on met la date sinon on efface la date
        If Not IsEmpty(Target) Then Target.Offset(0, 2).Value = Date Else Target.Offset(0, 2).ClearContents
        Application.EnableEvents = True
        Exit Sub
    End If
    
    'Cas de la validation
    If Target.Count = 1 And Target.Column = 2 Then
        'Sil n'y a qu'une cellule modifiée et qu'elle est en colonne B (2)
        On Error Resume Next
        'Facultatif Test pour vérifier qu'il s'agit bien d'une cellule de validation par le manager (Validation : OK, Commentaire : "VALIDATION DU MANAGER")
        test = Target.Validation.Formula1 = "OK" And Target.Comment.Shape.DrawingObject.Caption = "VALIDATION DU MANAGER"
        On Error GoTo 0
        If test And Target.Value = "OK" Then
            'Si la validation vaut OK
            Application.EnableEvents = False
            'Libellé dans la cellule voisine
            Target.Offset(0, 1).Value = "Vu par " & Application.UserName & " le " & Format(Date, "dd/mm/yyyy")
            Me.Unprotect Mdp 'Enlever la protection de la feuille
            Target.Offset(0, -1).MergeArea.Resize(, 10).Locked = True 'Verrouiller les cellules du mois
            Me.Protect Mdp 'remettre la protection de la feuille
            Application.EnableEvents = True
        End If
    End If
    
End Sub