Supprimer les onglets sauf le premier

Dim i As Byte
Application.DisplayAlerts = False
For i = 2 To Sheets.Count
    Sheets(i).Delete
Next i
Application.DisplayAlerts = True

Sub SupprimerOnglets()
Application.Displayalerts = False
For Each sh In Activeworkbook.Worksheets 
    If sh.Name <> activesheet.name then 
        sh.Delete 
    End If 
Next sh
Application.Displayalerts = True 
End Sub

Sub Supr_Feuilles()
Dim i As Integer
Application.DisplayAlerts = False
For i = Sheets.Count To 2 Step -1
     If Sheets(i).Index = i Then Sheets(i).Delete
Next i
Application.DisplayAlerts = True
End Sub

Sub Suppr_Feuilles2()
Dim F As Worksheet
Application.DisplayAlerts = False
For Each F In Worksheets
    If F.Index <> 1 Then F.Delete
Next F
Application.DisplayAlerts = True
End Sub

Sub Supprime()
Dim Liste(), i
ReDim Liste(1 To Sheets.Count - 1)
For i = 1 To UBound(Liste)
  Liste(i) = Sheets(i + 1).Name
Next
Application.DisplayAlerts = False
Sheets(Liste).Delete
End Sub

Sub Supprime()
Dim Liste(), i
ReDim Liste(1 To Sheets.Count - 1)
For i = 1 To UBound(Liste)
  Liste(i) = i + 1 'liste des index
Next
Application.DisplayAlerts = False
Sheets(Liste).Delete
End Sub

Sub Supprime()
Dim Liste As Object, i
Set Liste = CreateObject("Scripting.Dictionary")
For i = 2 To Sheets.Count
  Liste(i) = i 'liste des index
Next
Application.DisplayAlerts = False
On Error Resume Next 's'il n'y a plus qu'une feuille...
Sheets(Liste.Items).Delete
End Sub

Sub A_Supprime_Feuilles_Inutiles()
Stop
Msgbox "attention les feuilles vont être supprimées (faire ctrl+pause pour arrêter)!"
Dim NOMFeuilleAgarder(100)
NOMFeuilleAgarder(1) = "Trouve"
NOMFeuilleAgarder(2) = "Scan sur"
NOMFeuilleAgarder(3) = "Param"
NOMFeuilleAgarder(4) = "BO"
'Sheets("Feuil3").Move After:=Sheets(4)
'delBO
ThisWorkbook.Activate
NF = ThisWorkbook.Sheets.Count
Sheets(NOMFeuilleAgarder(1)).Move After:=Sheets(NF)
Sheets(NOMFeuilleAgarder(2)).Move After:=Sheets(NF)
Sheets(NOMFeuilleAgarder(3)).Move After:=Sheets(NF)
Sheets(NOMFeuilleAgarder(4)).Move After:=Sheets(NF)
'Stop
For i = 1 To NF - 4'adapter sur le nombre de feuilles à garder
Application.DisplayAlerts = False
Sheets(1).Delete
Application.DisplayAlerts = True
Next
Sheets(1).Activate
End Sub

Sub A_MAsque_Feuilles_Inutiles()
'Stop
On Error Resume Next
Dim NOMFeuilleAgarder(100)
NOMFeuilleAgarder(1) = "Planning2011"
'NOMFeuilleAgarder(2) = "Scan sur"
'NOMFeuilleAgarder(3) = "Param"
'NOMFeuilleAgarder(4) = "BO"
'Sheets("Feuil3").Move After:=Sheets(4)
'delBO
ThisWorkbook.Activate
'MsgBox ThisWorkbook.Name

NF = ThisWorkbook.Sheets.Count
Sheets(NOMFeuilleAgarder(1)).Move After:=Sheets(NF)
'Sheets(NOMFeuilleAgarder(2)).Move After:=Sheets(NF)
'Sheets(NOMFeuilleAgarder(3)).Move After:=Sheets(NF)
'Sheets(NOMFeuilleAgarder(4)).Move After:=Sheets(NF)
'Stop
For i = 1 To NF - 1'adapter sur le nombre de feuilles à garder
Application.DisplayAlerts = False
If Sheets(i).Visible = True Then Sheets(i).Visible = False
Application.DisplayAlerts = True
Next
Sheets(1).Activate
End Sub

Sub Affiche_Toutes_Feuilles()
Application.ScreenUpdating = False
nc = ActiveWorkbook.Sheets.Count
For n = 1 To nc
Sheets(n).Visible = True
Next
Application.ScreenUpdating = True
End Sub

Option Explicit
Sub test()
Dim ws As Worksheet
For Each ws In Worksheets
    ws.Select ws.Index <= 2
Next ws
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
End Sub

Sub test()
'Supprime_Feuilles sauf la feuille en première position
Application.ScreenUpdating = False
Dim ws As Worksheet
For Each ws In Worksheets
ws.Visible = True
Next ws
For Each ws In Worksheets
ws.Select ws.Index <= 2
Next ws
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Sub test2()
'supprime_Feuilles_sauf_celle_sélectionnée
Application.ScreenUpdating = False
'Stop
Position = ActiveSheet.Index
Dim ws As Worksheet
For Each ws In Worksheets
ws.Visible = True
Next ws
'Stop
Sheets(Position).Move before:=Sheets(1)
For Each ws In Worksheets
ws.Select ws.Index <= 2
Next ws
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub