Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Supprimer toutes les feuilles sauf la première

Toug

XLDnaute Junior
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:
Code:
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é

XLDnaute Barbatruc
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):
VB:
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

XLDnaute Barbatruc
Re : Supprimer toutes les feuilles sauf la première

Bonjour,

essaye peut être comme suit :
Code:
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

XLDnaute Accro
Re : Supprimer toutes les feuilles sauf la première

Bonjour Toug, Efgé,Pierrot93, le forum,

Macro pour supprimer toutes les feuilles sauf celle active :

Code:
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

XLDnaute Barbatruc
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 :

Code:
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

XLDnaute Barbatruc
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

Code:
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
 

DoubleZero

XLDnaute Barbatruc
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é...

VB:
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

XLDnaute Barbatruc
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).

Code:
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

XLDnaute Barbatruc
Re : Supprimer toutes les feuilles sauf la première

Re, bonsoir DoubleZero

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

Code:
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+
 
Dernière édition:

job75

XLDnaute Barbatruc
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+
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
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é)

Code:
Sub SupprFsaufF1()
Sheets(1).Copy
'mettre ici le code pour finaliser le truc ;)
End Sub
 
Dernière édition:

job75

XLDnaute Barbatruc
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

XLDnaute Barbatruc
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 :

Code:
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+
 

Pièces jointes

  • Une seule feuille(1).xls
    45.5 KB · Affichages: 71
Dernière édition:

DoubleZero

XLDnaute Barbatruc
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 .
 

Discussions similaires

Réponses
9
Affichages
284
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…