Effacer tous les onglets sauf 1

[Sophie11]

Bonjour
Je dispose d'un classeur de plusieurs onglets:
onglet1: pomme
onglet2: poire
onglet3: orange
Je voudrais effacer tous mes onglets sauf poire.

Je peux faire :

Sheets("pomme").delete
Sheets("orange").delete

Mais j'aimerais faire un code sans utiliser le nom de mes onglet (sauf pour poire) de sorte que lorsque de nouveau onglet s'ajoute ils sont aussi supprimer...

Merci d'avance

 

[Pierrot93]

Re : Effacer tous les onglets sauf 1

Bonjour Sophie,

essaye ainsi :

Option Explicit
Sub test()
Dim ws As Worksheet
Application.DisplayAlerts = False
For Each ws In Worksheets
    If ws.Name <> "poire" Then If Worksheets.Count > 1 Then ws.Delete
Next ws
Application.DisplayAlerts = True
End Sub

bonne journée
@+

 

[Sophie11]

Re : Effacer tous les onglets sauf 1

Merci ton code fonctionne. Par contre,ans le cas où ma feuille n'existe pas, il m'efface tout sauf la derniere. Il faudrait créer une condtion si la feuille n existe pas, on arrete la macro, si vous avez une idée? mon code est incorrect mais je pense que l'idée est là..

Dim ws As Worksheet
For Each ws In Worksheets
    If ws.Name <> "poire" Then
    MsgBox "Feuille non disponible"
    Exit Sub
    
    Else
Dim wss As Worksheet
Application.DisplayAlerts = False
For Each wss In Worksheets
    If wss.Name <> "poire" Then If Worksheets.Count > 1 Then wss.Delete
Next wss
Application.DisplayAlerts = True
     Exit For
    End If
Next ws

 

[Pierrot93]

Re : Effacer tous les onglets sauf 1

Re,

en fait tu ne veux pas exécuter la macro si la feuille "poire" n'existe pas, c'est à dire qu'aucune feuille ne sera supprimée dans ce cas ?

 

[Pierrot93]

Re : Effacer tous les onglets sauf 1

Re,

regarde le code ci-dessous, avec fonction personnalisée :

Option Explicit
Sub test()
Dim ws As Worksheet
If FeuilleExiste("poire") Is Nothing Then Exit Sub
Application.DisplayAlerts = False
For Each ws In Worksheets
    If ws.Name <> "poire" Then If Worksheets.Count > 1 Then ws.Delete
Next ws
Application.DisplayAlerts = True
End Sub


Function FeuilleExiste(f As String) As Worksheet
On Error Resume Next
Set FeuilleExiste = Worksheets(f)
End Function

bonne soirée
@+

 

[Sophie11]

Re : Effacer tous les onglets sauf 1

exact! merci beaucoup, ca fonctionne