Microsoft 365 ERREUR AUTOMATION DÉFAILLANCE IRRÉMÉDIABLE

Option Explicit

Private Sub cbSheet_Change()
 Dim GestionErreur As String
  On Error GoTo GestionErreur
   If cbSheet.Value <> "Selectionner un projet" Then
    Worksheets(cbSheet.Value).Select
   End If
    cbSheet.Value = "Selectionner un projet"
    Exit Sub
GestionErreur:
 MsgBox Err.Number & " , " & Err.Description
End Sub


Private Sub Worksheet_Activate()
 Application.ScreenUpdating = False '' optimation code
    Dim j As Integer, n As Integer, i As Integer
    
    For j = 1 To Sheets.Count
     If Sheets(j).Name <> "Accueil" And Sheets(j).Name <> "TABLEAU" And Sheets(j).Name <> "SITE" Then ActiveSheet.Range("AK65535").End(xlUp).Offset(1, 0) = Sheets(j).Name
    Next j
     ActiveSheet.Range("AK:AK").Sort key1:=Range("AK2"), order1:=xlAscending
        ActiveSheet.cbSheet.Clear
         n = ActiveSheet.Cells(Rows.Count, 37).End(xlUp).Row
       For i = 1 To n
       ActiveSheet.cbSheet.AddItem Cells(i, 37)
       Next i
      ActiveSheet.Range("AK:AK").ClearContents
    
    Application.ScreenUpdating = True 'optimisation code (Facultatif )
    
End Sub


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   UserForm1.Show
   Cancel = True
End Sub