Supprimer une feuille sur deux ?

Le 21/10/2018 à 15:13

Bonjour,

j'aimerais créer 2 nouveaux classeurs C1 C2 à partir du classeur initial C0

On prend C0 (qui contient une centaine de feuilles), et on lui appliquerait une macro (que je ne connais pas encore), pour qu'elle efface une feuille sur deux à partir de la feuille active (non incluse)

On sauvegarde sous le nom C1

On reprend C0 initial, et on applique une macro qui supprime une feuille sur deux, active comprise.

On sauvegarde sous le nom C2

Pouvez-vous m'aider à créer ces deux macros?

Merci d'avance.

Edit :

J'ai essayé ça, mais ça ne marche pas (en fait ça efface des feuilles deci-delà, pas forcément celles voulues) :

Sub Effass1sur2FeuillBis

Et celle-ci supprime les 11 premières feuilles...

Sub Effass1sur2Feuil()

'

' Effass1sur2Feuil Macro

' Macro enregistrée le 21/10/2018 par utilisateur

'

Dim i%, nf%

nf = Worksheets.Count * 2 - 1

Application.ScreenUpdating = False

For i = 2 To nf Step 2

Application.DisplayAlerts = False

ActiveSheet.Delete

i = i + 1

Next i

End Sub

Le 21/10/2018 à 16:41

Bonjour,

Les suppressions d'éléments d'une collection se font toujours de la fin vers le début (boucle avec un pas négatif).

Mais essaie plutôt ceci (pas testé) :

Sub DédoublerClasseur()
    Dim wk(1) As Workbook, f%
    Application.ScreenUpdating = False
    With ThisWorkbook
        .Worksheets(1).Copy: Set wk(1) = ActiveWorkbook
        .Worksheets(2).Copy: Set wk(0) = ActiveWorkbook
        For f = 3 To .Worksheets.Count
            .Worksheets(f).Copy after:=wk(f Mod 2).Worksheets((f - 1) \ 2)
        Next f
        wk(0).SaveAs .Path & "\C1.xlsx"
        wk(1).SaveAs .Path & "\C2.xlsx"
    End With
End Sub

Cordialement.

Le 22/10/2018 à 09:18

Bonjour,

Bonjour Maréchal,

une proposition qui tient compte de la feuille active.

Sub aargh1()
    Application.DisplayAlerts = False
    wsa = ThisWorkbook.ActiveSheet.Name
    ThisWorkbook.SaveCopyAs "wb1.xlsm"
    ThisWorkbook.SaveCopyAs "wb2.xlsm"
    Set wb = Workbooks.Open("wb1.xlsm")
    sc = wb.Sheets.Count
    iwsa = Sheets(wsa).Index
    If sc Mod 2 = iwsa Mod 2 Then sc = sc - 1
    For i = sc To iwsa + 1 Step -2
        wb.Sheets(i).Delete
    Next i
    wb.Save
    wb.Close
    Set wb = Workbooks.Open("wb2.xlsm")
    sc = wb.Sheets.Count
    iwsa = Sheets(wsa).Index
    If sc Mod 2 <> iwsa Mod 2 Then sc = sc - 1
    For i = sc To iwsa Step -2
        wb.Sheets(i).Delete
    Next i
    wb.Save
    wb.Close
    Application.DisplayAlerts = True
End Sub
Le 22/10/2018 à 11:10

Bonjour à vous deux,

merci pour vos codes, qui sont presque fonctionnels, à un poil près, je suppose.

Celui de MFerrand indique

bogu10

Et le debogage pointe --> .Worksheets(2).Copy:

Il doit manquer un clou dans le fer.

Et celui de h2so4 indique

bogu210

Le débogage pointe --> Set wb = Workbooks.Open("wb1.xlsm")

Ca doit sûrement coincer à la base ( )

Et puis, c'est ma faute, j'ai oublié de préciser que je suis sous Office 2003, je ne peux ouvrir les 2 fichiers créés.

bogu310

Je ne sais ouvrir que des xls (à mon âge c'est déjà bien)

Le 22/10/2018 à 11:35

Bonjour, Salut Sulfurique (comme dit Tulipe) !

J'ai supposé que lançant une telle opération, ton classeur contiendrait bien au moins 3 feuilles et n'ai pas pris de précaution particulière pour un classeur en contenant moins, estimant que tu ne lancerait pas d'opération dans ce cas !

Mais si tu as une erreur 9 sur .Worksheets(2) cela laisserait supposer qu'il n'y a pas de 2e feuille !

Je vais finalement tester ce code pour voir ce qu'il en est ! @+

Le 22/10/2018 à 11:49

Après test qui montre que le code fonctionne bien comme je l'avais prévu, voici le code rectifié pour opérer sur 2003 juste les deux lignes d'enregistrement des classeurs dans un classeur C0 contenant 7 feuilles :

  • le classeur doit être enregistré sur ton disque avant d'utiliser la macro !
  • comme tu as pu sans doute le constater, je n'opère pas par suppression, mais par constitution des deux classeurs résultant par copies de feuilles et simultanément,

- ton indication de feuille active étant imprécise, j'ai consédéré que par défaut la feuille 1 serait la feuille supposée active, en conséquence C1 contient les feuilles 2, 4, 6 et C2 les feuilles 1, 3, 5, 7.

A toi de tester.

edit : Je n'ai pas verrouillé suite à ton erreur donc tu auras une erreur 9 sur un classeur contenant moins de 3 feuilles ! Mais s'il faut te mettre un garde-fou pour te stopper lorsque tu as la tentation de dédoubler un classeur de moins de 3 feuilles, c'est bien sûr possible !

12c0.zip (10.99 Ko)
Le 22/10/2018 à 16:10

Hello !

merci pour le classeur C0, je l'ai testé avec ta macro, j'obtiens aussi erreur 9.

C'est à quelle heure qu'on s'arrache les cheveux ?

Le 22/10/2018 à 16:15

Bonjour,

un autre essai, non testé sur excel <2013

Sub aargh1()
    Application.DisplayAlerts = False
    wsa = ThisWorkbook.ActiveSheet.Name
    ThisWorkbook.SaveCopyAs "wb1.xls"
    ThisWorkbook.SaveCopyAs "wb2.xls"
    Set wb = Workbooks.Open("wb1.xls")
    sc = wb.Sheets.Count
    iwsa = Sheets(wsa).Index
    If sc Mod 2 = iwsa Mod 2 Then sc = sc - 1
    For i = sc To iwsa + 1 Step -2
        wb.Sheets(i).Delete
    Next i
    wb.Save
    wb.Close
    Set wb = Workbooks.Open("wb2.xls")
    sc = wb.Sheets.Count
    iwsa = Sheets(wsa).Index
    If sc Mod 2 <> iwsa Mod 2 Then sc = sc - 1
    For i = sc To iwsa Step -2
        wb.Sheets(i).Delete
    Next i
    wb.Save
    wb.Close
    Application.DisplayAlerts = True
End Sub
Le 22/10/2018 à 16:46

edit

Le 22/10/2018 à 16:57

Salut h2so4,

belle tentative, on y est presque ! Car je commence à peu près à comprendre pourquoi ça n'aboutit pas.

1. Toujours l'erreur 1004

2. Débogage --> wb.Sheets(i).Delete

3. J'ai pu ouvrir les fichiers wb1 et wb2, c'est super.

4. Chacun d'eux est en fait... un duplicata de ma page PERSO !!! et pas de la page sur laquelle j'ai appliqué la macro.

Je laisse toujours ouverte PERSO en plus des autres classeurs, sinon, je ne peux pas utiliser de macro.

Ça doit être pour ça que la macro de MFerrand bloque aussi, car ma PERSO a moins de 3 pages !

En effet, je viens de rajouter des feuilles au classeur PERSO, et j'ai lancé la macro de MFerrand, qui a fonctionné très bien cette fois.

Aarghhhh!

A chaque fois que je lance Excel, j'ai maintenant des messages d'erreur !

merde011

puis

merde010

puis

merde012

et

merde010

Au secours, Eric, s'il te plaît !

Le 22/10/2018 à 17:04

rebonjour,

je suppose qu'il n'aime pas l'extension xlsx, adapte le code de Mferrand pour sauver les fichiers avec une extension .xls

sinon pour prendre en compte le classeur ouvert, plutot que le classeur qui contient la macro

Sub aargh1()
    Application.DisplayAlerts = False
    wsa = ActiveWorkbook.ActiveSheet.Name
    ThisWorkbook.SaveCopyAs "wb1.xls"
    ThisWorkbook.SaveCopyAs "wb2.xls"
    Set wb = Workbooks.Open("wb1.xls")
    sc = wb.Sheets.Count
    iwsa = Sheets(wsa).Index
    If sc Mod 2 = iwsa Mod 2 Then sc = sc - 1
    For i = sc To iwsa + 1 Step -2
        wb.Sheets(i).Delete
    Next i
    wb.Save
    wb.Close
    Set wb = Workbooks.Open("wb2.xls")
    sc = wb.Sheets.Count
    iwsa = Sheets(wsa).Index
    If sc Mod 2 <> iwsa Mod 2 Then sc = sc - 1
    For i = sc To iwsa Step -2
        wb.Sheets(i).Delete
    Next i
    wb.Save
    wb.Close
    Application.DisplayAlerts = True
End Sub
Le 22/10/2018 à 17:30

Ouf ! Sauvé ! Merci

Il a fallu que j'aille dans XLSTART pour supprimer les fichiers C1 et C2, ça marche mieux maintenant.

Merci pour ton dernier code, il est EXTRA !

Le 22/10/2018 à 23:48

Bonsoir,

Je ne comprends pas tes erreurs ! Mon dernier code enregistrait en xls et au format 2003 !

        wk(0).SaveAs .Path & "\C1.xls", xlWorkbookNormal
        wk(1).SaveAs .Path & "\C2.xls", xlWorkbookNormal

Tu ne devais plus avoir de xlsx !?

Le 23/10/2018 à 09:42

Bonjour à tous,

Si souci à l'enregistrement essaie :

        wk(0).SaveAs .Path & "\C1.xls", xlExcel8
        wk(1).SaveAs .Path & "\C2.xls", xlExcel8

(xlExcel8 = 56 ; correspond aux classeurs Excel 97-2003)

Cdlt.

Le 23/10/2018 à 10:07

Salut Jean-Eric !

S'il travaille sur 2003, sauf erreur la constante xlExcel8 n'est apparue qu'après (en tout cas, je ne l'ai pas référencée sur Excel 2000)... S'il y a un souci, il faudra sans doute mettre l'enregistrement sous condition (ce qui risque de se passer est si enregistrement effectué avec une version 2007 ou ultérieure, il se fasse avec extension xls mais au nouveau format, et message à l'ouverture de non correspondance entre format et extension, ou incompatibilité si ouverture sur 2003...)

Cordialement.

Le 23/10/2018 à 10:34

Re,

@ MFerrand,

Tu as raison, une nouvelle fois de plus. Cela devient pénible.

Je suis parti de MS Office 2013 Developper, mon seul document pour les références VBA.

Aurais-tu un lien pour avoir l'identique pour 2003 ?

Cela peut s'avérer utile !

Sinon : if Application.version <12 then -4143 (xlWorkbookNormal) else 56 (XlExcel8)

Cdlt.

Le 23/10/2018 à 10:52

Re,

Pour vérifier je me réfère à l'Aide d'Excel 2000, quand l'Aide de 2010 ne signale pas la version d'apparition...

Mais ce problème d'enregistrement je l'avais eu à une époque où je travaillais sur 2010 mais en mode compatibilité, uniquement avec des fichiers xls, donc chaque fois que je créais un fichier il était enregistré au format 97-2003 avec extension xls, et j'avais bêtement pensé que cette option prévaudrait lors d'un enregistrement en VBA. Mais pas du tout, le fichier s'enregistrait bien avec extension xls puisque je l'introduisais dans le nom, mais le format était le nouveau format...

De l'utilité des erreurs... !

Le 24/10/2018 à 11:15

Merci à vous deux, c'est très sympa de m'avoir aidé.

Excellent site, vraiment EXCELlent

Rechercher des sujets similaires à "supprimer feuille deux"