XL 2016 Suppression de feuils en gardant des feuilles selon une caractéristique.

Valoute · 6 Septembre 2016

Bonjour,
je m'explique je cherche à supprimer toutes les feuilles correspondantes à un critère d'une cellule exemple pour garder les feuilles que j'ai besoins:

Code:

Sub Supression()
Dim Compteur As Integer, Nom As String
    Application.DisplayAlerts = False
    For Compteur = Worksheets.Count To 1 Step -1
        Nom = Sheets(Compteur).Name
        Select Case Nom
        Case Range("B3").Value, Range("B4").Value 'Etc...
           
        Case Else
            Sheets(Compteur).Delete
        End Select
    Next Compteur
    Application.DisplayAlerts = True
End Sub

Comment je peux faire pour qu'il comprenne que le nom de page à pas supprimer c'est en rapport avec une cellule.

Jacky67 · 6 Septembre 2016

Valoute à dit:
Bonjour,
je m'explique je cherche à supprimer toutes les feuilles correspondantes à un critère d'une cellule exemple pour garder les feuilles que j'ai besoins:

Code:

Sub Supression() Dim Compteur As Integer, Nom As String Application.DisplayAlerts = False For Compteur = Worksheets.Count To 1 Step -1 Nom = Sheets(Compteur).Name Select Case Nom Case Range("B3").Value, Range("B4").Value 'Etc... Case Else Sheets(Compteur).Delete End Select Next Compteur Application.DisplayAlerts = True End Sub

Comment je peux faire pour qu'il comprenne que le nom de page à pas supprimer c'est en rapport avec une cellule.

Bonjour,
Ceci supprime toutes les feuilles sauf celles ou le nom est inscrit entre b3 et bx

VB:

Sub Supression()
  Dim sh As Worksheet
  Application.DisplayAlerts = False
  For Each sh In ThisWorkbook.Worksheets
  If IsError(Application.Match(sh.Name, Sheets("Insupprimable").Range("b3:b" & Sheets("Insupprimable").Cells(Rows.Count, "B").End(xlUp).Row), 0)) Then
  If sh.Name <> ActiveSheet.Name Then sh.Delete
  End If
  Next
  Application.DisplayAlerts = True
End Sub

job75 · 7 Septembre 2016

Bonjour Valoute, Jacky67,

Ou aussi :

Code:

Sub Supression()
Dim d As Object, s As Object
Set d = CreateObject("Scripting.Dictionary")
For Each s In Sheets
  If Application.CountIf([B:B], s.Name) = 0 Then d(s.Name) = ""
Next
If d.Count = Sheets.Count Then MsgBox "Il faut conserver au moins une feuille !", 48: Exit Sub
If d.Count = 0 Then Exit Sub
Application.DisplayAlerts = False
Sheets(d.keys).Delete
End Sub

Bonne journée.

Valoute · 7 Septembre 2016

La macro fonctionne très bien c'est super cool, mais je suis exposé à un nouveau problème auquel je n'ai aucune compétence c'est comment faire pour y ajouter une selection plus manuel exemple: ajouter l'impossibilité de supprimer Sheets(1) et Sheets(2) en plus des feuilles situés en B.

job75 · 7 Septembre 2016

Re,

Code:

Sub Supression()
Dim d As Object, s As Object
Set d = CreateObject("Scripting.Dictionary")
For Each s In Sheets
  If s.Index > 2 And Application.CountIf([B:B], s.Name) = 0 Then d(s.Name) = ""
Next
If d.Count = 0 Then Exit Sub
Application.DisplayAlerts = False
Sheets(d.keys).Delete
End Sub

Edit : j'ai aussi ajouté If d.Count = 0 Then Exit Sub dans ma macro du post #3.

Bonne fin de soirée.

job75 · 7 Septembre 2016

Re,

De quel ajout parlez-vous ?

Je ne vois vraiment pas comment la macro du post #5 peut beuguer.

Edit : vous avez supprimé votre post #6... Pas glop ça

A+

XL 2016 Suppression de feuils en gardant des feuilles selon une caractéristique.

Valoute

XLDnaute Nouveau

Jacky67

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Valoute

XLDnaute Nouveau

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Discussions similaires