Dupliquer fichier et supprimer feuilles sauf 3

Bnojour,

je veux remplacer dans ma macro : (afin de pouvoir garder les macros et modules)

  Sheets(Array("Chantier", "Brassage", "Synoptique")).Copy

par ce code qui duplique et garde uniquement 3 feuilles

Sub SupprimeFeuille() 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 "feuil2", "feuil4", "rangement", "total" Case Else Sheets(Compteur).Delete End Select Next Compteur Application.DisplayAlerts = True End Sub

mais je n'y arrive pas (je suis sur excel 2007).

Bonjour Philippou, bonjour le forum,

Difficile de te comprendre !... Tu parles de trois onglets et tu en cites 4 ("feuil2", "feuil4", "rangement", "total"), tu nous montres une première ligne de code qui n'apparaît pas dans le second. Je suis vraiment incapable de te proposer quelque chose...

bonjour,

oui effectivement, la ligne que je montre c'est celle que je veux remplacer (elle copie 3 feuilles) dans un nouveau classeur (mais sans les macros)

donc effectivement l'autre macro montre 4 feuilles, mais je veux bien 3 feuilles, j'ai récupérer ce code sur un autre post.

donc à la base je veux créer un fichier avec les 3 feuilles et les macros + modules, donc je crois que le plus simple c'est de duplique le fichier et supprimer toutes les feuilles sauf les 3 que je veux garder.

Re,

Outre le fait que ton second code soit sur une seule ligne ?!..., Qu'est-ce qui ne va pas dans celui-ci ?!...

je suis nul en vba, je sais pas la mettre à la place de l'autre ligne;

Re,

Hou la !...

quand je mets en place les DIM au début et une ligne qui commence par application...ça coince

bonjour,

comment adapter cette ligne pour l'insérer dans une macro existante du coup :

]Sub SupprimeFeuille() 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 "Chantier", "Brassage", "Synoptique" Case Else Sheets(Compteur).Delete End Select Next Compteur Application.DisplayAlerts = True

lorsque j'écris :

Sub creer_fichier_chantier()
 Dim objWorkbookCible As Workbook
 Dim objworkbooksource As Workbook
 Dim Compteur As Integer, Nom As String  

  Set objworkbooksource = ActiveWorkbook
  Application.DisplayAlerts = False For Compteur = Worksheets.Count To 1 Step -1 Nom = Sheets(Compteur).Name Select Case Nom Case "Chantier", "Brassage", "Synoptique" Case Else Sheets(Compteur).Delete End Select Next Compteur Application.DisplayAlerts = True
 dossiers_fichiers
End Sub  

ça bloque su la ligne application.displayalerts....

merci

Re,

Écoute Philippou, le code ne peut pas être écrit n'importe comment. Je ne sais pas d'où tu les sors mais il manque des retours de chariot (retours à la ligne). Je ne comprend rien à ce que tu veux faire. Je t'ai juste écrit le code correctement avec une explication à chaque ligne sur les deux codes. J'espère que ça te permettra de comprendre :

Sub creer_fichier_chantier()
Dim objWorkbookCible As Workbook 'déclare la vairable objWorkbookCible (classeur cible)
Dim objworkbooksource As Workbook 'déclare la vairable objworkbooksource (classeur source)
Dim Compteur As Integer, Nom As String 'déclare la varible compteur (entier) et la variable nom (texte)

Set objworkbooksource = ActiveWorkbook 'définit la variable objworkbooksource (le classeur actif)
Application.DisplayAlerts = False 'masque les messages d'Excel
For Compteur = Worksheets.Count To 1 Step -1 'boucle inversée sur tous les onglets du dernier au premier (de quel classeur ? Il faudrait le préciser)
    Nom = Sheets(Compteur).Name 'définit la variable Nom (nom de l'onglet de la boucle)
    Select Case Nom 'agit en fonction de la variable Nom (nom de l'onglet de la boucle)
        Case "Chantier", "Brassage", "Synoptique" 'cas Chantier, Brassage et Synoptique (rien ne se passe)
        Case Else 'tous les autres cas
            Sheets(Compteur).Delete 'l'onglet est suprimé
    End Select 'fin de l'action en fonction de la variable Nom
Next Compteur 'prochain onglet de la boucle
Application.DisplayAlerts = True 'affiche les message d'Excel
dossiers_fichiers '??? c'est quoi ça ?
End Sub

Sub SupprimeFeuille()
Dim Compteur As Integer, Nom As String 'déclare la varible compteur (entier) et la variable nom (texte)

Application.DisplayAlerts = False 'masque les messages d'Excel
For Compteur = Worksheets.Count To 1 Step -1 'boucle inversée sur tous les onglets du dernier au premier (de quel classeur ? Il faudrait le préciser)
    Nom = Sheets(Compteur).Name 'définit la variable Nom (nom de l'onglet de la boucle)
    Select Case Nom 'agit en fonction de la variable Nom (nom de l'onglet de la boucle)
        Case "Chantier", "Brassage", "Synoptique" 'cas Chantier, Brassage et Synoptique (rien ne se passe)
        Case Else 'tous les autres cas
            Sheets(Compteur).Delete 'l'onglet est suprimé
    End Select 'fin de l'action en fonction de la variable Nom
Next Compteur 'prochain onglet de la boucle
Application.DisplayAlerts = True 'affiche les message d'Excel
End Sub

Merci Thau Thème : ta macro marche mais ça me fait un autre bug :

- ta macro garde donc les feuilles désirées + les modules => nickel

par contre mon fichier de base où je lance la macro suivante, ce fichier ce ferme sans sauvegarde (cela ne se produisait pas avant), voici la macro:

Sub dossiers_fichiers()
'par: Excel-Malin.com ( https://excel-malin.com )
    On Error GoTo ExempleErreur

Dim NouveauDossierAvecSousDossiers As String
Dim dossier1 As String
Dim dossier2 As String
Dim bat As Integer
Dim dossier3 As String
Dim fichier As String
Dim chemin As String

dossier1 = Sheets("Chantier").Range("C7").value & " - " & Sheets("Chantier").Range("C16").value & " - " & Sheets("Chantier").Range("C15").value
bat = Sheets("Chantier").Range("C29").value
    If bat > 4 And bat > 0 Then
        dossier2 = "Immeuble"
    Else
         dossier2 = "pavillon"
    End If
dossier3 = Sheets("Chantier").Range("C6").value
fichier = "Fiche suivi chantier lot " & Sheets("Chantier").Range("C7") & " - " & Sheets("Chantier").Range("C6") & ".xlsm"

    NouveauDossierAvecSousDossiers = ThisWorkbook.Path & "\" & dossier1 & "\" & dossier2 & "\" & dossier3
    CreerDossier (NouveauDossierAvecSousDossiers)
    chemin = NouveauDossierAvecSousDossiers & "\" & fichier

        ActiveWorkbook.SaveAs Filename:=chemin, _
        FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
        Workbooks(fichier).Close False
        MsgBox "Fiche chantier sauvegardé"
Exit Sub
ExempleErreur:
    MsgBox "Une erreur est survenue..."
End Sub

Re,

Le fait d'enregistrer-sous fait que le classeur sur lequel tu travaillais est remplacé. Je te propose de le sauver avant de l'enregistrer-sous. Il se sera plus ouvert mais au moins il sera enregistré. J'ai fait quelques commentaire sur le code :

Sub dossiers_fichiers()
Dim NouveauDossierAvecSousDossiers As String
Dim dossier1 As String
Dim dossier2 As String
Dim bat As Integer
Dim dossier3 As String
Dim fichier As String
Dim chemin As String

On Error GoTo ExempleErreur
dossier1 = Sheets("Chantier").Range("C7").Value & " - " & Sheets("Chantier").Range("C16").Value & " - " & Sheets("Chantier").Range("C15").Value
bat = Sheets("Chantier").Range("C29").Value
If bat > 4 And bat > 0 Then 'si bat est supérieur à 4 il sera toujours supérieur a 0 je pense que c'est < 4 ce qui signifierais compris entre 0 et 4
    dossier2 = "Immeuble"
Else
     dossier2 = "pavillon"
End If
dossier3 = Sheets("Chantier").Range("C6").Value
fichier = "Fiche suivi chantier lot " & Sheets("Chantier").Range("C7") & " - " & Sheets("Chantier").Range("C6") & ".xlsm"
NouveauDossierAvecSousDossiers = ThisWorkbook.Path & "\" & dossier1 & "\" & dossier2 & "\" & dossier3
CreerDossier (NouveauDossierAvecSousDossiers)
chemin = NouveauDossierAvecSousDossiers & "\" & fichier

ActiveWorkbook.Save '<=== enregistre le fichier

ActiveWorkbook.SaveAs Filename:=chemin, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Workbooks(fichier).Close False 'tu peux aussi commenter cette ligne si tu veux que la copie reste ouverte...
MsgBox "Fiche chantier sauvegardé"
Exit Sub

ExempleErreur:
    MsgBox "Une erreur est survenue..."
End Sub

je suis pas spécialiste VBA, mais du coup je crois que le code ci-dessous se sert de mon fichier de base pour supprimer les onglets inutiles et ensuite enregistrer...

comment dupliquer en premier le fichier et ensuite applique au fichier dupliquer la macro pour suprimer les onglets inutiles ?

Sub creer_fichier_chantier()
Dim objWorkbookCible As Workbook 'déclare la vairable objWorkbookCible (classeur cible)
Dim objworkbooksource As Workbook 'déclare la vairable objworkbooksource (classeur source)
Dim Compteur As Integer, Nom As String 'déclare la varible compteur (entier) et la variable nom (texte)

Set objworkbooksource = ActiveWorkbook 'définit la variable objworkbooksource (le classeur actif)
Application.DisplayAlerts = False 'masque les messages d'Excel
For Compteur = Worksheets.Count To 1 Step -1 'boucle inversée sur tous les onglets du dernier au premier (de quel classeur ? Il faudrait le préciser)
    Nom = Sheets(Compteur).Name 'définit la variable Nom (nom de l'onglet de la boucle)
    Select Case Nom 'agit en fonction de la variable Nom (nom de l'onglet de la boucle)
        Case "Chantier", "Brassage", "Synoptique" 'cas Chantier, Brassage et Synoptique (rien ne se passe)
        Case Else 'tous les autres cas
            Sheets(Compteur).Delete 'l'onglet est suprimé
    End Select 'fin de l'action en fonction de la variable Nom
Next Compteur 'prochain onglet de la boucle
Application.DisplayAlerts = True 'affiche les message d'Excel
dossiers_fichiers '??? c'est quoi ça ?
End Sub