Supprimer toutes les feuilles sauf la première

[Toug]

Bonjour,
Pour initialiser ma macro je voudrais supprimer toutes les feuilles sauf la première qui me sert de base.
J'ai écrit un code, mais ça ne semble pas marcher, je ne comprend pas pourquoi:

Application.DisplayAlerts = False
Dim wSheets As Worksheet
For i = 2 To 10

    On Error Resume Next
    Set wSheet = Sheets(i)
    If wSheets Is Nothing Then
        MsgBox "Nexistepas" & i
    Else
        Sheets(i).Delete
    End If
Next i

End Sub

Avec ce code, j'ai l'impression que les feuilles n'existent pas, dois y avoir une mauvaise syntaxe quelque part.

Merci d'avance.

 

[Efgé]

Re : Supprimer toutes les feuilles sauf la première

Bonjour Toug,
Quand on supprime quelque chose (lignes, colonnes, feuilles, etc...) il est préférable de commencer par la fin en remontant (step - 1):

Sub SuprFeuille()
Application.DisplayAlerts = False
For i = ThisWorkbook.Sheets.Count To 2 Step -1
    Sheets(i).Delete
Next i
Application.DisplayAlerts = True
End Sub

Cordialement

 

[Pierrot93]

Re : Supprimer toutes les feuilles sauf la première

Bonjour,

essaye peut être comme suit :

Option Explicit
Sub test()
Dim i As Integer
With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    For i = Sheets.Count To 2 Step -1
        Sheets(i).Delete
    Next i
    .DisplayAlerts = True
    .ScreenUpdating = True
End With
End Sub

bon après midi
@+

Edition : bonjour fg

 

[libellule85]

Re : Supprimer toutes les feuilles sauf la première

Bonjour Toug, Efgé,Pierrot93, le forum,

Macro pour supprimer toutes les feuilles sauf celle active :

Sub EffacementTouteFeuille()
Dim Ctr As Integer
Application.DisplayAlerts = False
  For Ctr = Sheets.Count To 1 Step -1
    If Sheets(Ctr).Name <> ActiveSheet.Name Then
      Sheets(Ctr).Delete
    End If
  Next
  Application.DisplayAlerts = True
End Sub

 

[job75]

Re : Supprimer toutes les feuilles sauf la première

Bonjour Toug, Efgé, Pierrot, libellule,

Une solution nettement plus rapide sur un grand nombre de feuilles :

Sub SupprimeFeuilles()
If Sheets.Count = 1 Then Exit Sub
Dim tablo(), i
ReDim tablo(Sheets.Count - 2)
For i = 2 To ThisWorkbook.Sheets.Count
    tablo(i - 2) = Sheets(i).Name
Next
Application.DisplayAlerts = False
Sheets(tablo).Delete
End Sub

Les feuilles sont supprimées en bloc.

A+

 

[tototiti2008]

Re : Supprimer toutes les feuilles sauf la première

Bonjour à tous,

ou sur la base du code de job, simplement avec le numéro des feuilles

Sub SupprimeFeuilles()
    If Sheets.Count = 1 Then Exit Sub
    Dim tablo(), i As Long
    ReDim tablo(Sheets.Count - 2)
    For i = 2 To ThisWorkbook.Sheets.Count
        tablo(i - 2) = i
    Next
    Application.DisplayAlerts = False
    Sheets(tablo).Delete
    Application.DisplayAlerts = True
End Sub

 

[job75]

Re : Supprimer toutes les feuilles sauf la première

Bonsoir tototiti

Avec les index c'est plus simple en effet, je n'y avais pas pensé.

A+

 

[DoubleZero]

Re : Supprimer toutes les feuilles sauf la première

Bonjour, le Fil , le Forum,

Une autre proposition, en adaptant le nom de l'onglet devant être préservé...

Sub Onlets_supprimer_sauf_BASE()
Dim w As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each w In Worksheets
If w.Name <> "BASE" Then w.Delete 'Adapter le nom de l'onglet à préserver !
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

A bientôt .

 

[MJ13]

Re : Supprimer toutes les feuilles sauf la première

Bonjour à tous

Sympas tous ces codes .

Je me sert de celui ci pour ne garder que N feuilles avec certaines à afficher (ici 4 à garder et 2 à afficher).

Sub A_Supprime_Feuilles_Inutiles()
'Stop
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
Application.DisplayAlerts = False
Sheets(1).Delete
Application.DisplayAlerts = True
Next
Sheets(NOMFeuilleAgarder(3)).Visible = False
Sheets(NOMFeuilleAgarder(4)).Visible = False
Sheets(1).Activate
End Sub

 

[job75]

Re : Supprimer toutes les feuilles sauf la première

Re, bonsoir DoubleZero

On peut aussi utiliser l'objet Dictionary, normalement plus rapide :

Sub SupprimeFeuilles()
If Sheets.Count = 1 Then Exit Sub
Dim d As Object, i As Long
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To Sheets.Count
  d(i) = i
Next
Application.DisplayAlerts = False
Sheets(d.keys).Delete
End Sub

Je ne mets pas Application.DisplayAlerts = True, il n'est pas nécessaire à la fin.

Edit : Michel est arrivé, salut à toi aussi y a du beau monde ce soir !

A+

 

[job75]

Re : Supprimer toutes les feuilles sauf la première

Re,

J'ai testé la suppression de 1000 feuilles sur Excel 2010 :

- code de Pierrot => 5,54 s

- code du post #10 (ajouté .ScreenUpdating = False) => 4,63 s

- [Edit] code du post #6 (tototiti avec .ScreenUpdating = False) => 4,50 s

Avec les tableaux, ce n'est pas aussi rapide que je l'espérais...

A+

 

[Staple1600]

Re : Supprimer toutes les feuilles sauf la première

Bonsoir à tous

La solution je pense la plus rapide
(puisqu'il s'agit de garder aucunes feuilles sauf la première, copions donc cette sheets(1) dans un nouveau classeur, et le tour est joué)

Sub SupprFsaufF1()
Sheets(1).Copy
'mettre ici le code pour finaliser le truc ;)
End Sub

 

[job75]

Re : Supprimer toutes les feuilles sauf la première

Bonjour le fil, le forum,

Staple a tout à fait raison

Mais en restant sur les suppressions, je viens de retester sur 1000 feuilles :

- post #6 (tototiti) => 4,30 s

- post #8 (DoubleZero) => 3,20 s

La suppression par tableau n'apporte rien, de toute façon Excel supprime les feuilles une par une.

A+

 

[job75]

Re : Supprimer toutes les feuilles sauf la première

Re,

J'ai voulu voir ce que donnait la suggestion de Staple au post #12.

Si l'on veut que le nouveau fichier remplace l'ancien, ce n'est pas de la tarte.

Placer ces 3 macros dans le code de la 1ère feuille :

Private Sub CommandButton1_Click()
Dim n As Byte, Wb As Workbook
Application.ScreenUpdating = False
n = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1
Set Wb = Workbooks.Add 'nouveau document
Me.Copy Before:=Wb.Sheets(1)
Application.DisplayAlerts = False
Wb.Sheets(2).Delete
Application.SheetsInNewWorkbook = n
Wb.Names.Add "fichier", ThisWorkbook.Path & "\" & ThisWorkbook.Name 'mémorisation
Application.Run Wb.Name & "!" & Wb.Sheets(1).CodeName & ".Lance"
ThisWorkbook.Close False 'fermeture sans enegistrement
End Sub

Sub Lance()
Application.OnTime Now, Me.CodeName & ".Remplace"
End Sub

Sub Remplace()
Dim fich$, test As Boolean, FileFormatNum As Byte
On Error Resume Next
fich = [fichier]
ThisWorkbook.Names("fichier").Delete
Kill fich 'suppression du fichier d'origine
'---enregistrement toujours en .xls---
test = Val(Application.Version) < 12
FileFormatNum = IIf(test, xlWorkbookNormal, 56)
Application.DisplayAlerts = False
ThisWorkbook.SaveAs Replace(fich, ".xlsm", ".xls"), FileFormatNum
End Sub

Fichier joint.

A+

 

[DoubleZero]

Re : Supprimer toutes les feuilles sauf la première

Bonjour, le Fil, le Forum,

... Je ne mets pas Application.DisplayAlerts = True, il n'est pas nécessaire à la fin...

Grand Merci, job75 , pour cette précision.

Mais... à présent, j’avoue ne plus savoir comment procéder .

En effet, il y a peu, un magicien d’XLD m’a gentiment fait remarquer l’absence de «Application.DisplayAlerts = True» à la fin de mon code.

A présent, job75, autre magicien d'XLD, tente de me faire comprendre une subtilité qui, malheureusement , m'échappe !

A bientôt .