Macro pour supprimer les feuilles d'un classeur avec conditions

Christophe avait énoncé :

Bonjour:

Je travaille avec Excel 2007 sous Windows XP.

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

Merci par avance pour votre aide.

Christophe

Bonjour.
Essaie :

Sub test()
For Each c In Sheets("Company Data").Range([B1], [B65536].End(xlUp))
If c.Value <> "Company Data" And c.Value <> "Country Data" Then
Application.DisplayAlerts = False
Sheets(c.Value).Delete
Application.DisplayAlerts = true²
End If
Next c
End Sub

cordialement.
Daniel

Bonjour,
'------------------
Sub jj()
With Sheets("Company Data")
For Each c In Range(.[B1], .[B65536].End(xlUp))
If c.Value <> "Company Data" And c.Value <> "Country Data" Then
Application.DisplayAlerts = False
On Error Resume Next
Sheets(c.Value).Delete
Err = 0
Application.DisplayAlerts = True
End If
Next c
End With
End Sub
'-----------------
--
Salutations
JJ


"Christophe" <cjoly@mail.doc.gov> a écrit dans le message de news:
17dd29d5-0183-45cb-972a-bc7d927621bc@i4g2000prf.googlegroups.com...
Bonjour:

Je travaille avec Excel 2007 sous Windows XP.

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

Merci par avance pour votre aide.

Christophe

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

Bonjour:

merci Daniel. malheureusement je n'arrive pas à tester ta macro.
Jacky en a écrit une qui est très similaire à la tienne. J'arrive à
la tester en revanche, elle ne fonctionne pas :-(

Sincères salutations.

Christophe

J'ai mis un bouton sur la feuille. Appuie dessus.
http://www.cijoint.fr/cjlink.php?file=cj201008/cijvyUmIek.xls
Daniel

Bonjour:

merci Daniel. malheureusement je n'arrive pas à tester ta macro.
Jacky en a écrit une qui est très similaire à la tienne. J'arrive à
la tester en revanche, elle ne fonctionne pas :-(

Sincères salutations.

Christophe

Oups. Erreur de post.

J'ai mis un bouton sur la feuille. Appuie dessus.
http://www.cijoint.fr/cjlink.php?file=cj201008/cijvyUmIek.xls
Daniel

Bonjour:

merci Daniel. malheureusement je n'arrive pas à tester ta macro.
Jacky en a écrit une qui est très similaire à la tienne. J'arrive à
la tester en revanche, elle ne fonctionne pas :-(

Sincères salutations.

Christophe

Qu'est-ce que tu entends par "Je n'arrive pas à la tester" ?
Il y a une erreur ?
Daniel

Bonjour:

merci Daniel. malheureusement je n'arrive pas à tester ta macro.
Jacky en a écrit une qui est très similaire à la tienne. J'arrive à
la tester en revanche, elle ne fonctionne pas :-(

Sincères salutations.

Christophe

Bonjour,

Au début tu as donné 2 noms donc c'était simple avec If
maintenant tu change pour plein de noms .
Dans ces cas là en plus faut faire tres gaffe à l'instruction And
dans le if...
(point que je n'approfondirai pas ici)

Alors plutôt que de faire des chapelets de saucisses avec des If et
des And
utilise un Select Case
A toi d'adapter cet exemple à tes propres libellés:

Sub delFeuil()
Dim c As Range
For Each c In [maplage].Cells
Select Case c
Case "Feuil1", "Feuil3"
'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

'LSteph

On 3 août, 14:44, Christophe <cj...@mail.doc.gov> wrote:

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

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" <cjoly@mail.doc.gov> a écrit dans le message de news:
5bc2c0a2-4c35-4035-89ae-65b04f9d986d@y11g2000yqm.googlegroups.com...
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

...petite rectif :

Sub delFeuil()
Dim c As Range
For Each c In [maplage].Cells
Select Case c
Case "Feuil1", "Feuil3"
'on fait rien
Case Else
On Error Resume Next
Application.DisplayAlerts = False
Sheets(c.Value).Delete
Application.DisplayAlerts = True
On Error GoTo 0
End Select
Next
End Sub


On 3 août, 16:30, LSteph <gmlst...@gmail.com> wrote:

Bonjour,

Au début tu as donné 2 noms donc c'était simple avec If
maintenant tu change pour plein de noms .
Dans ces cas là en plus faut faire tres gaffe à l'instruction And
dans le if...
(point que je n'approfondirai pas ici)

Alors plutôt que de faire des chapelets de saucisses avec des If et
des And
utilise un Select Case
A toi d'adapter cet exemple  à tes  propres libellés:

Sub delFeuil()
Dim c As Range
For Each c In [maplage].Cells
    Select Case c
    Case "Feuil1", "Feuil3"
    '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

'LSteph

On 3 août, 14:44, Christophe <cj...@mail.doc.gov> wrote:



> 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 son t
> 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- Masquer le texte des messages précédents -

- Afficher le texte des messages précédents -