Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel Macro pour supprimer les feuilles d'un classeur avec conditions

Macro pour supprimer les feuilles d'un classeur avec conditions

14 réponses
Avatar
Christophe
Bonjour:

Je travaille avec Excel 2007 sous Windows XP.

Je souhaiterais cr=E9er une macro pour effacer toutes les feuilles d'un
classeur dont les noms sont list=E9s dans la colonne B de la feuille
"Company Data" =E0 l'exception des feuilles "Company Data" et "Country
Data" au cas ou ces noms seraient eux aussi list=E9s dans la colonne B
de la feuille "Company Data"

Merci par avance pour votre aide.

Christophe
Signaler un problème avec ce contenu

4 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2
Avatar
Jacky
Re...
Si la liste des feuilles à ne pas supprmer est complète, tu peux te passer de celle sur la feuille "Company
Data"
'------------------
Sub jj()
Dim sh As Worksheet
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> "What is the Scheduler" And sh.Name <> "Instructions" And sh.Name <> "Fax Template" And
sh.Name <> "Country Data" And sh.Name <> "Company Data" And sh.Name <> "Country Appointments" And sh.Name <>
"Company Appointments" And sh.Name <> "Statistics" And sh.Name <> "EmailAllCountrySchedules" And sh.Name <>
"EmailAllCompanySchedules" And sh.Name <> "Transitory4" Then
Application.DisplayAlerts = False
On Error Resume Next
MsgBox sh.Name & vbLf & "Sera supprimer après validation de la ligne ""Delete"" " '*** a eliminer
après tests
' Sheets(sh.Name).Delete ' a valider après tests
Err = 0
Application.DisplayAlerts = True
End If
Next
End Sub
'----------------------------
--
Salutations
JJ


"Jacky" a écrit dans le message de news: 4c5829f5$0$10227$
RE...
Bizarre....sauf si les infos seraient au delà de la ligne 65536
Attention à l'orthographe des noms de feuilles
Voir ici
http://www.cijoint.fr/cjlink.php?file=cj201008/cijPhs4TQF.xls
Penser à valider la ligne " Sheets(c.Value).Delete'
après les tests
et supprimer celle du "Msgbox........"

'----------------
Sub jj()
With Sheets("Company Data")
For Each c In Range(.[B3], .Cells(Rows.Count, 2).End(3))
If c.Value <> "What is the Scheduler" And c.Value <> "Instructions" And c.Value <> "Fax Template" And
c.Value <> "Country Data" And c.Value <> "Company Data" And c.Value <> "Country Appointments" And c.Value <>
"Company Appointments" And c.Value <> "Statistics" And c.Value <> "EmailAllCountrySchedules" And c.Value <>
"EmailAllCompanySchedules" And c.Value <> "Transitory4" Then
Application.DisplayAlerts = False
On Error Resume Next
MsgBox c & vbLf & "Sera supprimer après validation de la ligne ""Delete"" " '*** a eliminer après
tests
' Sheets(c.Value).Delete ' a valider après tests
Err = 0
Application.DisplayAlerts = True
End If
Next c
End With
End Sub
'------------------
--
Salutations
JJ


"Christophe" a écrit dans le message de news:

Bonjour Jacky:

J'ai testé ta macro modifiée comme suit:

With Sheets("Company Data")
For Each c In Range(.[B3], .[B65536].End(xlUp))
If c.Value <> "What is the Scheduler" And c.Value <>
"Instructions" And c.Value <> "Fax Template" And c.Value <> "Country
Data" And c.Value <> "Company Data" And c.Value <> "Country
Appointments" And c.Value <> "Company Appointments" And c.Value <>
"Statistics" And c.Value <> "EmailAllCountrySchedules" And c.Value <>
"EmailAllCompanySchedules" And c.Value <> "Transitory4" Then
Application.DisplayAlerts = False
On Error Resume Next
Sheets(c.Value).Delete
Err = 0
Application.DisplayAlerts = True
End If
Next c
End With

Malheureusement, elle n'a pas supprimé les feuilles dont les noms sont
listés en B3:B65536 de la feuille "Company Data" mais de surcroit les
feuilles "Fax Template" et "Country Data" ont été supprimées.

Je ne comprends pas?????


Christophe



Avatar
Christophe
Bonjour Steph:

Merci. J'ai adapté ta macro à mon projet (voir ci-dessous). Meme si
maintenant les feuilles à garder ne sont plus supprimées, les feuilles
dont les noms sont listés en Sheets("Company
Data").Range("B4:B200").Cells ne sont toujours pas supprimées et je ne
comprends pas pourquoi.
Ceci étant je viens de contourner le problème en ne créant plus les
feuilles à la condition qu'elles soient vides donc je n'ai plus à les
supprimer.

Une nouvelle fois merci.

Christophe



Sub delFeuil()
Dim c As Range
For Each c In Sheets("Company Data").Range("B4:B200").Cells
Select Case c
Case "What is the Scheduler", "Instructions", "Fax Template",
"Country Data", "Company Data", "Country Appointments", "Company
Appointments", "Statistics", "EmailAllCountrySchedules",
"EmailAllCompanySchedules", "Transitory4"
'on fait rien
Case Else
On Error Resume Next
Application.DisplayAlerts = False
ThisWorkbook.Sheets(c.Value).Delete
Application.DisplayAlerts = True
On Error GoTo 0
End Select
Next
End Sub
Avatar
Christophe
Bonjour:

Merci Jacky. Malheureusement la liste des feuilles à ne pas supprimer
n'est pas exhaustive et je ne peux pas compléter car elle est très
longue et aléatoire (ma fille fille me dirait de ne pas utiliser des
mots que je ne comprends pas:-)

Ceci étant j'ai contourné le problème en ne créant plus les feuille s
dont les noms sont en Sheets("Company Data")
Range(.[B3], .[B65536].End(xlUp)) et par conséquent je n'ai plus à
les supprimer et le tour est joué.

Merci.

Christophe
Avatar
LSteph
Bonjour,

Je ne sais pas d'où tu lance la macro dans le doute
enlève Thisworkbook. juste avant le Sheets(c.value).delete

A priori sinon si elles ne sont toujours pas supprimées c'est qu'il
doit y avoir une très légère différence d'orthographe
(un espace avant ou après que sais je) entre ta liste et les noms de
feuille

--
LSteph


On 4 août, 00:20, Christophe wrote:
Bonjour Steph:

Merci.  J'ai adapté ta macro à mon projet (voir ci-dessous).  Mem e si
maintenant les feuilles à garder ne sont plus supprimées, les feuille s
dont les noms sont listés en Sheets("Company
Data").Range("B4:B200").Cells ne sont toujours pas supprimées et je ne
comprends pas pourquoi.
Ceci étant je viens de contourner le problème en ne créant plus les
feuilles à la condition qu'elles soient vides donc je n'ai plus à les
supprimer.

Une nouvelle fois merci.

Christophe

Sub delFeuil()
Dim c As Range
For Each c In Sheets("Company Data").Range("B4:B200").Cells
    Select Case c
    Case "What is the Scheduler",  "Instructions", "Fax Template",
"Country Data", "Company Data", "Country Appointments", "Company
Appointments", "Statistics", "EmailAllCountrySchedules",
"EmailAllCompanySchedules", "Transitory4"
    'on fait rien
    Case Else
    On Error Resume Next
    Application.DisplayAlerts = False
        ThisWorkbook.Sheets(c.Value).Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    End Select
Next
End Sub
1 2