Macro suppression feuilles

Public mesfeuilles()

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    For j = 1 To ThisWorkbook.Worksheets.Count
        Trouve = False
        For i = 1 To UBound(mesfeuilles)
            If ThisWorkbook.Worksheets(j).CodeName = mesfeuilles(i) Then Trouve = True: Exit For
        Next i
        If Trouve = False Then
            Application.DisplayAlerts = False
            ThisWorkbook.Worksheets(j).Delete
            Application.DisplayAlerts = True
        End If
    Next j
End Sub

Private Sub Workbook_Open()
    ReDim mesfeuilles(ThisWorkbook.Worksheets.Count)
    For i = 1 To ThisWorkbook.Worksheets.Count
        mesfeuilles(i) = ThisWorkbook.Worksheets(i).CodeName
    Next i
End Sub

Option Explicit
'-1-
Private Sub Workbook_NewSheet(ByVal sh As Object)
    sh.Name = "X " & sh.Name
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim sh As Worksheet
    Application.DisplayAlerts = False
    For Each sh In ThisWorkbook.Worksheets
        If Left(sh.Name, 1) = "X" Then sh.Delete
    Next sh
End Sub

'-2-
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim sh As Worksheet
    Application.DisplayAlerts = False
    For Each sh In ThisWorkbook.Worksheets
        Select Case sh.Name
            Case "Feuil1", "Feuil3", "Feuil6"
                '
            Case Else
                sh.Delete
        End Select
    Next sh
End Sub

Public mesfeuilles()

Option Explicit
Dim d As Object 'mémorise la variable

Private Sub Workbook_Open()
Dim s As Object
Set d = CreateObject("Scripting.Dictionary")
For Each s In Sheets
d(s.CodeName) = ""
Next
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim s As Object
If d Is Nothing Then Exit Sub
Application.DisplayAlerts = False
For Each s In Sheets
If Not d.exists(s.CodeName) Then s.Delete
Next
End Sub