XL 2010 Supprimer les feuilles non présente dans une liste

[counterbob]

Bonjour, ma question est presque dans le titre.
Sur un classeur se trouve dans la feuille "Liste" une liste de noms correspondant aux feuilles qui doivent être présente.
je souhaiterais un code qui supprime les feuilles qui ne sont pas présente dans la liste.
Je bloque. J'ai essayé ce code mais c'est pas bon du tout.
Je joins un classeur exemple
merci pour une piste

Sub deleteFeuille()
Dim nom As String
For i = 2 To Sheets("Liste").Range("A1").End(xlDown).Offset(1, 0).Row - 1
nom = Cells(i, 1).Value
For Each sh In Sheets
If sh.Name <> nom Then
Application.DisplayAlerts = False
sh.Delete
Application.DisplayAlerts = True
End If
Next
Next
End Sub

 

[Staple1600]

Bonsoir le fil, counterbob

counterbob
En attendant mieux (et plus secure)

Sub Test_OK()
Dim liste, i%
Set f = Worksheets("Liste")
liste = Application.Transpose(f.Range("A2", f.Cells(Rows.Count, "A").End(3)))
For i = LBound(liste) To UBound(liste)
On Error Resume Next
Application.DisplayAlerts = False
Worksheets(liste(i)).Delete
Application.DisplayAlerts = True
Next
End Sub

 

[counterbob]

Bonsoir le fil, counterbob

counterbob
En attendant mieux (et plus secure)

Sub Test_OK()
Dim liste, i%
Set f = Worksheets("Liste")
liste = Application.Transpose(f.Range("A2", f.Cells(Rows.Count, "A").End(3)))
For i = LBound(liste) To UBound(liste)
On Error Resume Next
Application.DisplayAlerts = False
Worksheets(liste(i)).Delete
Application.DisplayAlerts = True
Next
End Sub

Merci Staple1600,
mais ça supprime toutes les feuilles sauf "Liste"
Je vais creuser cette piste
@+

 

[mapomme]

Bonsoir @counterbob, @Staple1600

Voir la macro suivante:

Sub SupprimerHorsListe()
Dim wsh
  Application.ScreenUpdating = False: Application.DisplayAlerts = False
  For Each wsh In Worksheets
    If wsh.Name <> "Liste" Then If Application.CountIf(Sheets("Liste").Range("a:a"), wsh.Name) = 0 Then wsh.Delete
  Next wsh
  'si vous désirez supprimer la feuille Liste, alors activer la ligne suivante
  'Sheets("Liste").Delete
  Application.DisplayAlerts = True
End Sub

edit : version plus concise

 

[Hasco]

Bonjour,
Hi, Staple

Supprime les feuilles non dans la liste (y compris la feuille liste qui elle n'est pas dans la liste)

Sub deleteFeuille()
    Dim liste As Variant
    Dim i As Integer
    With ThisWorkbook
        With .Sheets("Liste").Range("A1").CurrentRegion
            liste = .Offset(1).Resize(.Rows.Count - 1)
        End With
        Application.DisplayAlerts = False
        For i = .Sheets.Count To 1 Step -1
            If IsError(Application.Match(.Sheets(i).Name, liste, 0)) Then .Sheets(i).Delete
        Next
        Application.DisplayAlerts = True
    End With
End Sub

Cordialement

[Edit] Hello @mapomme

 

[Staple1600]

Re, bonjour mapomme, Rerere Roblochon

Désolé, j'ai compris le contraire
Ma macro supprime les feuilles qui sont dans la liste
Du coup, c'est fâcheux

M'en vais corriger cela

EDITION: Quoique, si j'étais moi, j'aimerai bien le IsError de Roblochon et du coup je lacherais l'affaire

 

[mapomme]

Bonjour @Roblochon

@Staple1600
Et alors, mapomme, qui n'a pas de IsErrror, on le néglige comme une vieille chaussette. Du coup, m'en vais en mettre un.

Sub SupprimerHorsListe()
Dim wsh
  Application.ScreenUpdating = False: Application.DisplayAlerts = False
  For Each wsh In Worksheets
    If wsh.Name <> "Liste" Then If Application.CountIf(Sheets("Liste").Range("a:a"), wsh.Name) = 0 Then wsh.Delete
  Next wsh
  'si vous désirez supprimer la feuille Liste, alors activer la ligne suivante
  'Sheets("Liste").Delete
  Application.DisplayAlerts = True
  If IsError(0) Then:   '----- juste pour Staple1600
End Sub

 

[Staple1600]

Re

mapomme
Merci pour l'attention
Mais ceci m'aurait mieux sied au teint
If IsError(1600) Then:

 

[mapomme]

Re @Staple1600,
Dans ce cas

If IsError(CVErr(1600)) Then MsgBox "1660 est bien une erreur"

est bien plus probant
Allez, je sors. A+

 

[Staple1600]

Re,

mapomme
Tant que ceci est vrai, tout me va

Sub Test()
MsgBox Not IsObject("Staple1600")
End Sub

Allez moi aussi je sors de là (même si je ne suis pas une célébrité)
A+

 

[counterbob]

Bonsoir @counterbob, @Staple1600

Voir la macro suivante:

Sub SupprimerHorsListe()
Dim wsh
  Application.ScreenUpdating = False: Application.DisplayAlerts = False
  For Each wsh In Worksheets
    If wsh.Name <> "Liste" Then If Application.CountIf(Sheets("Liste").Range("a:a"), wsh.Name) = 0 Then wsh.Delete
  Next wsh
  'si vous désirez supprimer la feuille Liste, alors activer la ligne suivante
  'Sheets("Liste").Delete
  Application.DisplayAlerts = True
End Sub

edit : version plus concise

Bonsoir Mapomme, excellent !
c'est parfait
@+

 

[counterbob]

Merci à tous pour vos post.
le sujet est clos

 

[Hasco]

Bonjour,

...Arf Du coup c'est moi et ma soluce qui semblent être invisibles!

A+