Supprimer tous les onglets Feuilxxx

gilbert_RGI

XLDnaute Barbatruc

• 9 Août 2016

• #2

Bonjour,

il y a l'instruction Kill pathname

mais attention une fois supprimé pas de retour en arrière

 

Vote positif 0 Vote négatif

travolta

XLDnaute Junior

• 9 Août 2016

• #3

Merci Gilbert_RGI, mais en fait, je ne connais pas à l'avance les noms que vont avoir les feuilles.
J'utilise une macro qui crée une feuil temporaire à chque fois qu'elle s'exécute, et à chque fois je me retrouve avec 50 nouvelles feuilles, avec le numéro qui a incrémenté.
C'est pour ça que je voudrais pouvoir çà la fin de ma macro un bout de code qui supprime les n feuilles crées 🙂

 

Vote positif 0 Vote négatif

gilbert_RGI

XLDnaute Barbatruc

• 9 Août 2016

• #4

Kill ne détruit pas les feuilles mais le classeur peu importe le n-feuille

 

Vote positif 0 Vote négatif

gilbert_RGI

XLDnaute Barbatruc

• 9 Août 2016

• #5

si tu veux détruire toutes les feuilles après la feuille 2

VB:

Sub supp_feuille()
    Application.DisplayAlerts = False
    For i = 3 To Sheets.Count
        Sheets(i).Delete
    Next i
    Application.DisplayAlerts = True
End Sub

 

Vote positif 0 Vote négatif

travolta

XLDnaute Junior

• 9 Août 2016

• #6

Merci, par contre je ne veux supprimer que les feuilles qui s'appellent feuil1, feuil2, feuilxxx, toutes les autres feuilles du classeur je veux les garder 🙂

là j'ai l'impression que ta macro supprime toutes les feuilles quelquesoient leurs noms, hormis la 1ere feuille ?

 

Vote positif 0 Vote négatif

gilbert_RGI

XLDnaute Barbatruc

• 9 Août 2016

• #7

une autre solution
dans la première feuille en colonne A tu mets le nom des feuilles que tu veux conserver
et tu lances ce programme

VB:

Sub SuppFeuill()
    For i = Sheets.Count To 2 Step -1
        test = 0
        For j = 1 To Range("A65535").End(xlUp).Row
            If Sheets(i).Name = Cells(j, 1) Then test = 1
        Next j
        If test = 0 Then
            Application.DisplayAlerts = False
            Sheets(i).Delete
        End If
    Next i
    Application.DisplayAlerts = True
End Sub

 

Vote positif 0 Vote négatif

travolta

XLDnaute Junior

• 9 Août 2016

• #8

Merci, par contre comme mes feuilles sont déjà renommées, je ne sais pas laquelle est la 1ere feuille

 

Vote positif 0 Vote négatif

gilbert_RGI

XLDnaute Barbatruc

• 9 Août 2016

• #9

la première à gauche
il faut juste activer la feuille possédant ces infos au lancement de la macro

 

Vote positif 0 Vote négatif

JCGL

XLDnaute Barbatruc

• 9 Août 2016

• #10

Bonjour à tous,
Salut Gilbert,

Peux-tu essayer avec :

VB:

Sub SuppFeuill()
Dim x&
    For x = Sheets.Count To 2 Step -1
        Application.DisplayAlerts = False
            If Left(Sheets(x).Name, 5) = "Feuil" Then Sheets(x).Delete
            Application.DisplayAlerts = True
    Next x
End Sub

A+ à tous

 

Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc

• 10 Août 2016

• #11

Bonjour travolta, Gilbert, Jean-Claude,

Pour le fun :

Code:

Sub SuppFeuilles()
Dim s As Object, a$(), n&
For Each s In Sheets
  If s.Name Like "Feuil*" Then _
    ReDim Preserve a(n): a(n) = s.Name: n = n + 1
Next
If n And n < Sheets.Count Then _
  Application.DisplayAlerts = False: Sheets(a).Delete
End Sub

Bonne journée.

 

Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc

• 10 Août 2016

• #12

Re,

J'ai testé avec 1000 feuilles :

Code:

Sub SuppFeuilles()
Dim dur, s As Object, a$(), n&
dur = Timer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
For Each s In Sheets
  If s.Name Like "Feuil*" Then
    ReDim Preserve a(n)
    a(n) = s.Name
    n = n + 1
    If n Mod 20 = 0 Then Sheets(a).Delete: n = 0
  End If
Next
Sheets(a).Delete
MsgBox "Durée " & Format(Timer - dur, "0.00 \s")
End Sub

Chez moi (Win 10 - Excel 2013) la suppression par paquets de 20 est la plus rapide (5 secondes).

A+

 

Vote positif 0 Vote négatif

Dranreb

XLDnaute Barbatruc

• 10 Août 2016

• #13

Bonjour job75.
À la fin, il faut, il me semble :
If n > 0 Then Sheets(a).Delete

 

Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc

• 10 Août 2016

• #14

Hello Bernard,

Dranreb à dit:

Bonjour job75.
À la fin, il faut, il me semble :
If n > 0 Then Sheets(a).Delete

Cliquez pour agrandir...

Le test n'est pas nécessaire puisqu'il y a On Error Resume Next

A+

 

Vote positif 0 Vote négatif