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