Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Sauvegarde de plusieurs feuilles dans un nouveau classeur par département

Créer une discussion
  • Initiateur de la discussion Initiateur de la discussion KIM
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
K

KIM

XLDnaute Accro
Bonjour les ami(e)s et le forum,
J'ai essayé plusieurs techniques de sauvegarde du forum. J'ai réussi à sauvegarder feuille par feuille mais je n'ai pas pu sauvegarder un ensemble de feuilles dans un nouveau classeur par département. Je vous remercie de votre aide.
En effet Selon les types de données sources, j'ai pu créer des fichiers correspondants par type de sources et par Département. Les feuilles sont nommées par le nom du département sur 4 car suivi du type des données sources (ex DP01_R_Surf). J'en ai au moins 120 feuilles. Je souhaite sauvegarder les feuilles de chaque département dans un classeur du nom du département (Ex: Dans le classeur DP01.xls je souhaite retrouver toutes les feuilles dont les noms commencent par le meme nom departement avec la feuille Aide). La feuille "Aide" sera copiée dans chaque nouveau classeur du nom du département. Voir fichier ci-joint
Merci encore
KIM
 

Pièces jointes

Trier par date Trier par votes
Re : Sauvegarde de plusieurs feuilles dans un nouveau classeur par département

Bonsoir KIM,

Vois si le fichier joint en retour effectue bien ce que tu souhaites. Macro ici :
VB: 
Sub VoyonsCa()
Dim nFich$, nFLong$, nOnglet$, t&
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For t = 1 To ActiveWorkbook.Sheets.Count
    If Left$(Sheets(t).Name, 2) = "DP" Then
        nFich = "DP" & Mid(Sheets(t).Name, 3, 2)
        nFLong = ActiveWorkbook.Path & "\" & nFich & ".xls"
        If Dir(nFLong) = "" Then
            ActiveWorkbook.SaveCopyAs Filename:=nFLong
            Application.Workbooks.Open (nFLong)
            Sheets("Menu").Delete
            For u = ActiveWorkbook.Sheets.Count To 1 Step -1
                nOnglet = Sheets(u).Name
                If UCase(Left$(nOnglet, 4)) <> UCase(Left$(ActiveWorkbook.Name, 4)) And nOnglet <> "Aide" Then Sheets(u).Delete
            Next
            ActiveWorkbook.Close True
        End If
    End If
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

La macro scanne les onglets. Dès qu'elle en trouve un qui commence par DP+N° de département sur 2 octets, elle vérifie qu'elle ne l'a pas déjà traité en vérifiant si y a pas dans le répertoire courant de fichier qui porte le même nom. A ce moment, elle vire les onglets qui ne concernent pas le dpt qu'il faut avant de le sauvegarder et de passer à l'onglet suivant.

Télécharger
 
Vote positif 0 Vote négatif
Re : Sauvegarde de plusieurs feuilles dans un nouveau classeur par département

Bonsoir Softmama, bonsoir le forum,
Merci, la macro répond bien à ma demande. Par contre, après lancement de la macro :
1- je ne peux pas ouvrir les fichiers créés par Departement si je ne ferme pas le classeur initial? Pourquoi?
2- Est-il possible que la sauvegarde se fasse sans les macros du initial et sans les formules dans les feuilles, seulement les valeurs?
3- Est-il possible de sauvegarder les fichiers des départements dans un répertoire nommé "RECAP_DP" du répertoire courant?

Merci d'avance pour ton aide.
Bonne soirée
KIM
 
Vote positif 0 Vote négatif
Re : Sauvegarde de plusieurs feuilles dans un nouveau classeur par département

Re,

1- Bizarre ! Je suis dsl mais cela doit venir de ton environnement, car je ne rencontre pas le pb ici.

2- Pour virer macro :
Ajoute cette ligne
VB: 
ActiveWorkbook.VBProject.VBComponents.Remove ActiveWorkbook.VBProject.VBComponents.Item("Module1")
avant :
VB: 
ActiveWorkbook.Close True

2bis- Pour garder que valeurs, remplace cette ligne :
VB: 
If UCase(Left$(nOnglet, 4)) <> UCase(Left$(ActiveWorkbook.Name, 4)) And nOnglet <> "Aide" Then Sheets(u).Delete
par
VB: 
If UCase(Left$(nOnglet, 4)) <> UCase(Left$(ActiveWorkbook.Name, 4)) And nOnglet <> "Aide" Then Sheets(u).Delete Else Sheets(u).UsedRange = Sheets(u).UsedRange.Value

3- Pour sauvegarder dans Répertoire Recap_DP, ajoute :
VB: 
If Dir(ActiveWorkbook.Path & "\" & "RECAP_DP\", vbDirectory) = "" Then MkDir (ActiveWorkbook.Path & "\" & "RECAP_DP\")
Avant :
Code: 
For t=1 to...

La macro totale est devenue comme ceci :
VB: 
Sub VoyonsCa()
Dim nFich$, nFLong$, nOnglet$, t&
Application.ScreenUpdating = False
Application.DisplayAlerts = False
If Dir(ActiveWorkbook.Path & "\" & "RECAP_DP\", vbDirectory) = "" Then MkDir (ActiveWorkbook.Path & "\" & "RECAP_DP\")
For t = 1 To ActiveWorkbook.Sheets.Count
    If Left$(Sheets(t).Name, 2) = "DP" Then
        nFich = "DP" & Mid(Sheets(t).Name, 3, 2)
        nFLong = ActiveWorkbook.Path & "\" & nFich & ".xls"
        If Dir(nFLong) = "" Then
            ActiveWorkbook.SaveCopyAs Filename:=nFLong
            Application.Workbooks.Open (nFLong)
            Sheets("Menu").Delete
            For u = ActiveWorkbook.Sheets.Count To 1 Step -1
                nOnglet = Sheets(u).Name
                If UCase(Left$(nOnglet, 4)) <> UCase(Left$(ActiveWorkbook.Name, 4)) And nOnglet <> "Aide" Then Sheets(u).Delete Else Sheets(u).UsedRange = Sheets(u).UsedRange.Value
            Next
            ActiveWorkbook.VBProject.VBComponents.Remove ActiveWorkbook.VBProject.VBComponents.Item("Module1")
            ActiveWorkbook.Close True
        End If
    End If
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Je te laisse tester...
 
Vote positif 0 Vote négatif
Re : Sauvegarde de plusieurs feuilles dans un nouveau classeur par département

Re,

ça m'apprendra à pas tester mes modifs... Je viens de réaliser que j'ai oublié de modifier le chemin pour sauvegarder les fichiers afin de répondre correctement à ton attente du 3-
Aussi, remplace dans la macro, la ligne
Code: 
        nFLong = ActiveWorkbook.Path & "\" & nFich & ".xls"
par
Code: 
        nFLong = ActiveWorkbook.Path & "\RECAP_DP\" & nFich & ".xls"
 
Vote positif 0 Vote négatif
Re : Sauvegarde de plusieurs feuilles dans un nouveau classeur par département

Re,
Merci pour tes réponses rapides. En effet:
1- J'ai toujours le même blocage. De même je ne peux pas lancer une 2ième fois la macro tant que le répertoire de sauvegarde n'est pas vide.
2- la suppression du module "Module1" se fait bien. Par contre j'ai une dizaine de modules, est-ce que je dois dupliquer le code de suppression de module autant de fois de modules à supprimer ou y a t il une commande generale pour supprimer tous les modules du
VBProject
Merci d'avance
KIM
 
Vote positif 0 Vote négatif
Re : Sauvegarde de plusieurs feuilles dans un nouveau classeur par département

Bonjour,
KIM à dit:
Re,
1- J'ai toujours le même blocage. De même je ne peux pas lancer une 2ième fois la macro tant que le répertoire de sauvegarde n'est pas vide.
KIM
Cliquez pour agrandir...
1- Il est normal que si les fichiers existent déjà, la macro ne gère pas l'onglet concerné : elle a été créée pour ça. Pour le reste, je n'ai pas de pb chez moi.

Tu peux remplacer la ligne avec "Module1" par :
VB: 
For i = Thisworkbook.VBProject.VBComponents.Count To 1 Step -1
    If Thisworkbook.VBProject.VBComponents.Item(i).Type = 1 Then Thisworkbook.VBProject.VBComponents.Remove Thisworkbook.VBProject.VBComponents.Item(i)
Next i
 
Vote positif 0 Vote négatif
Re : Sauvegarde de plusieurs feuilles dans un nouveau classeur par département

Bonjour Softmama, & le forum,
Merci pour l'aide et les conseils,
J'ai remplacé Thisworkbook.VBProject.VBComponents.Count To 1 Step -1
par Activeworkbook.VBProject.VBComponents.Count To 1 Step -1
car avec Thisworkbook.etc., il supprime les macros du fichier initial.

Merci encore,
Il me reste le blocage de la macro de regroupement des feuilles par Département dans un nouveau classeur. J'ai plusieurs macros, c'est la seule macro qui bloque. Je continue mon exploration et te tiens au courant.
Bonne journée
KIM
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Question Question
Microsoft 365 Comment exporter certaines feuilles d'un classeur dans un nouveau classeur.
Réponses
2
Affichages
435
Jacky67
J
  • Résolu(e)
Microsoft 365 Impression groupée de plusieurs feuilles dans plusieurs onglets
2
Réponses
15
Affichages
604
Phil69970
  • Question Question
Microsoft 365 Création automatique de feuille et le remplissage correspondant
Réponses
8
Affichages
319
gbinforme
G
  • Question Question
XL 2021 Comment supprimer des noms du gestionnaire de noms dans un classeur
Réponses
7
Affichages
759
jeff1494
P
  • Résolu(e)
Microsoft 365 Utiliser la même macro dans des feuilles différentes
2 3
Réponses
35
Affichages
938
cathodique
M
  • Résolu(e)
XL 2021 Récupérer la valeur d’une cellule dans un classeur fermé
Réponses
5
Affichages
231
patricktoulon
F
  • Question Question
XL 2016 Tableau de bord Excel 2016
Réponses
2
Affichages
481
Dand87
D
D
  • Question Question
Microsoft 365 Mise à jour des références / liens depuis un sharepoint
Réponses
3
Affichages
363
Dégé59
D
  • Résolu(e)
XL 2013 Empêcher l'affichage d'une fenêtre flottante pour certaines feuilles spécifiques dans un classeur
Réponses
5
Affichages
192
Khrysthof
S
  • Question Question
Microsoft 365 Consolider des données de plusieurs feuilles
Réponses
2
Affichages
339
Sissou71
S
S
  • Question Question
XL 2013 enregistrer une feuille excel converti en pdf dans un répertoire selon la valeur d'une cellule
Réponses
5
Affichages
532
Phil69970
C
  • Résolu(e)
XL 2016 Automatisation de l'alimentation des cellules de plusieurs feuilles Excel (Formules : Recherchev...)
Réponses
10
Affichages
374
micheldu52
  • Question Question
XL 2016 copie de donnees horizontale en verticale
2
Réponses
25
Affichages
694
job75
R
  • Question Question
XL 2010 Copier des lignes de données de plusieurs feuilles dans une seule
Réponses
6
Affichages
739
AtTheOne
  • Question Question
Microsoft 365 Calcul total horaire entre 1er jour et dernier jour de chaque mois
Réponses
5
Affichages
252
pompaero
B
  • Question Question
Microsoft 365 Protection de zone de cellule selon utilisateur sur un fichier Excel
Réponses
2
Affichages
181
berta8683
B
F
  • Question Question
XL 2013 VBA- Liaisons entre 2 feuilles
Réponses
1
Affichages
158
vgendron
R
  • Question Question
XL 2010 Copie de données de plusieurs feuilles dans une seule
Réponses
5
Affichages
811
Renaud22
R
T
  • Résolu(e)
Microsoft 365 Exporter les plages nommées vers un nouveau classeur - plage nommée invalide selon VBA
Réponses
2
Affichages
399
tnion
T
P
  • Question Question
XL 2019 Changer nom d'export en VBA
Réponses
3
Affichages
800
job75
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…