Microsoft 365 mémo_clic fonctionnement

' Variable tableau Public avec Stockage de 3 Objets
    Public TabCord(1 To 1, 1 To 3) As Range
'
Sub active()
Application.EnableEvents = True
End Sub
Sub desactive()
ActiveSheet.Unprotect Password:=""
Application.EnableEvents = False
End Sub

Private Sub Worksheet_SelectionChange(ByVal r As Range)
    Set TabCord(1, 1) = Me.Range(Me.Cells(3, 2), Me.Cells(3, 25))
' Sortie si choix de la cible
    If TabCord(1, 1).Row = r.Row Then Exit Sub
' Depart
    Me.Unprotect Password:=""
    Application.EnableEvents = False
    Application.ScreenUpdating = False
'
    If Not (TabCord(1, 2) Is Nothing) Then
        TabCord(1, 2).EntireRow.ClearFormats
        TabCord(1, 2).RowHeight = 15
    End If
'
'   Adresse Cible (A Consigner)
        Set TabCord(1, 3) = Range(Cells(r.Row, 2), Cells(r.Row, 24))
'     Format Cible (A Formater)
        TabCord(1, 1).Copy
            With TabCord(1, 3)
                .PasteSpecial Paste:=xlPasteFormats
                .RowHeight = 40
            End With
        Application.CutCopyMode = False
'
    Set TabCord(1, 2) = TabCord(1, 3)
'
' Fin
    ActiveSheet.Protect Password:="", DrawingObjects:=True, Contents:=True, Scenarios:=True
    ActiveSheet.EnableSelection = xlNoRestrictions
    Application.EnableEvents = True
    Application.ScreenUpdating = True
'
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
' Sortie du classeur
' Ne pas enregistrer la variable (CustomProperties)
' Précédente Adresse Cible (Suppression tous format et Hauteur ligne 15)
' Depart
    ActiveSheet.Unprotect Password:=""
    Application.EnableEvents = False
    Application.ScreenUpdating = False
'
    If Not (TabCord(1, 2) Is Nothing) Then
        With TabCord(1, 2)
            .EntireRow.ClearFormats
            .RowHeight = 15
        End With
        ActiveSheet.Cells(3, 1).Select
    End If
'
' Fin
    ActiveSheet.Protect Password:="", DrawingObjects:=True, Contents:=True, Scenarios:=True
    ActiveSheet.EnableSelection = xlNoRestrictions
    Application.EnableEvents = True
    Application.ScreenUpdating = True
'
End Sub