Fragmenter 1 classeur en classeurS
Bonjour,
Je souhaiterais pouvoir découper ma feuille "données" de mon classeur de base "dispatcher avec modèle puis compiler" par manager de façon à ce que chaque manager ait un fichier qui lui est propre selon le modèle "Model".
Puis faire le travail de compilation en retour sur ma feuille "données recompilées" de mon classeur de base.
J'ai trouvé un travail préalable de Steelson : https://www.excel-pratique.com/fr/telechargements/utilitaires/dispatcher-compiler-excel-no466
Cela bogue pour "incompatibilité de type" sur :
For i = LBound(data) + 1 To UBound(data) ' hors en-têtePourriez-vous m'aider ?
Merci
J'ai pu récupérer une macro qui fonctionne en adaptant mon fichier mais cela n'est pas 100% concluant.
En effet je souhaite mettre des feuilles annexes en consultation ou pour références à des listes déroulantes.
C'est pourquoi l'idée d'une base et d'un classeur modèle dans lequel vient se déverser la donnée (et pouvant comporter d'autres feuilles) est plus adapté (macro ci-dessus si fonctionnelle).
Mais je poste cette solution pour ceux qui n'auraient pas un besoin aussi large.
Bonjour Alaid, bonjour le forum,
Je te propose le code ci-dessous (qui remplacerait l'ancien).
Il considère que les deux fichiers se trouvent dans le même dossier et les fichiers créés seront eux aussi dans ce dossier et porteront le nom du manager :
Option Explicit 'oblige à déclarer toutes les variables
Sub dispatcher()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TS As ListObject 'déclare la variable TS (Tableau Structuré)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim LI As Integer 'déclare la variable LI (LIgne)
Set CS = ThisWorkbook 'définit le classeur source CS
CA = CS.Path & "\" 'définit le chemin d'accès CA
Set OS = CS.Worksheets("données") 'définit l'onglet source OS
TV = OS.Range("B9").CurrentRegion 'définit le tabelau des valeurs TV
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
Set CD = Workbooks("model.xlsm") 'définit le classeur destination CD (génère une erreur si ce classeur n'est pas ouvert)
If Err <> 0 Then 'condition : si une erreur a été générée
Err.Clear 'supprime l'erreur
Set CD = Workbooks.Open(CA & "model.xlsm") 'définit le classeur destiantion CD en l'ouvrant
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
Set OD = CD.Worksheets("Import Compétences") 'définit l'onglet destination OD
Set TS = OD.ListObjects("Tableau1") 'définit le tableau structuré TS
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 3 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs (en partant de la 3ème)
D(TV(I, 13)) = "" 'alimente le dictionnaire D avec la donnée en colonne 13 de TV (le manager)
Next I 'prochaine ligne de la boucle
TMP = D.keys 'récupère dans le tableau temporaire TMP la liste des éléments du dictionnaire D sans doublon (les clés)
For J = 0 To UBound(TMP) 'boucle 1 : sur tous les éléments du tableau temporaire TMP (les managers)
If TS.ListRows.Count > 0 Then TS.DataBodyRange.Delete 'si le tableau structuré contient au moins une ligne, supprime ls données de TS
For I = 3 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes I du tableau des valeurs (en partant de la 3ème)
If TV(I, 13) = TMP(J) Then 'condition : si la donnée ligne I colonne 13 de TV est égale à la donnée J de TMP (même manager)
TS.ListRows.Add 'ajoute une ligne à TS
LI = TS.ListRows.Count 'définit la ligne LI
For K = 1 To UBound(TV, 2) 'boucle 3 sur toutes les colonne K de TV
TS.DataBodyRange(LI, K) = TV(I, K) 'récupère dans TS ligne LI, colonne K la donnée de TV ligne I colonne K
Next K 'prochaine colonne de la boucle 2
End If 'fin de la condition
Next I 'prochaine ligne de la boucle 2
'enregistre une copie du classeur destination dans le même dossier et avec le nom du manager comme nom de fichier
CD.SaveCopyAs (CA & TMP(J) & ".xlsm")
Next J 'prochain élément de la boucle 1 (prochain manager)
MsgBox "Données Traitées !" 'message
End SubThauThème
Merci !!!! Ca fonctionne super bien !
Je peux avoir des feuilles supplémentaires dans mon modèle et elles sont reprises telles quelles.
Je poste le fichier avec la Macro fonctionnelle.
Je me penche sur le code aujourd'hui et semaine prochaine pour le comprendre (j'aurais peut-être quelques questions pour pouvoir progresser).
Merci encore !
Bonjour ThauThème,
J'ai essayé d'avancer sur la partie recompilation des données (classeurs "A", "B", "C" à réincorporer dans la feuille "Compilation" du fichier "Base"). J'ai fait un peu de jardinage et ai pu déterrer d'anciens sujets où tu es intervenu.
J'ai donc construit sur le même fonctionnement que tes macros, mais avec moins de talent. Cela ne fonctionne pas. Si je comprends bien il me manque des infos au niveau des "???" -> il me faudrait indiquer les lignes à aller chercher puis indiquer où les copier ?
Mayday mayday
Sub Compiler()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TS As ListObject 'déclare la variable TS (Tableau Structuré)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim F As String 'déclare la variable F (Fichier)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim R As Range 'déclare la variable R (Recherche)
Dim LI As Integer 'déclare la variable LI(LIgne)
Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Worksheets("Compilation") 'définit l'onglet destination OD
Set TS = OD.ListObjects("Tableau1") 'définit le tableau structuré TS
CA = CD.Path & "\" 'définit le chemin d'accès CA
F = Dir(CA & "*.xlsm") 'définit le premier fichier F ayant CA comme chemin d'accès
Do While F <> "" 'exécute tant qu'il existe des fichiers F
If F <> ThisWorkbook.Name Then 'condition : si F n'est pas le fichier destination
Set CS = Application.Workbooks.Open(CA & F) 'définit le classeur source CS en l'ouvrant
Set OS = CS.Worksheets(1) 'définit l'onglet source (ici le premier, à adapter à ton cas)
Set R = TS.ListColumns(1).Range.Find("") 'définit la recherche R (recherche du vide dans la colonne 1 de TS)
If R Is Nothing Or TS.ListRows.Count = 0 Then 'condition : si aucune occurrence n'est trouvée
TS.ListRows.Add 'ajoute une ligne à TS
LI = TS.ListRows.Count 'définit la ligne LI (dernière ligne de TS)
Else 'sinon
LI = R.Row - TS.HeaderRowRange.Row 'définit la ligne LI (ligne de la première occurrence trouvée moins la ligne des entête)
End If 'fin de la condition
'récupération des données de la fiche
???
CS.Close False 'ferme la classeur source sans enregistrer
End If 'fin de la condition
F = Dir 'définit le prochain fichier F ayant CA comme chemin d'accès
Loop 'boucle
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
MsgBox "Données compilées !" 'message
End SubBonjour Alaid, bonjour le forum,
Essaie comme ça :
Sub Compiler()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TS As ListObject 'déclare la variable TS (Tableau Structuré)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim F As String 'déclare la variable F (Fichier)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim R As Range 'déclare la variable R (Recherche)
Dim LI As Integer 'déclare la variable LI(LIgne)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne) <---------- ICI
Dim NL As Integer 'déclare la varaible NL (Nombre de Lignes)<---------- ICI
Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Worksheets("Compilation") 'définit l'onglet destination OD
Set TS = OD.ListObjects("Tableau1") 'définit le tableau structuré TS
CA = CD.Path & "\" 'définit le chemin d'accès CA
F = Dir(CA & "*.xlsm") 'définit le premier fichier F ayant CA comme chemin d'accès
Do While F <> "" 'exécute tant qu'il existe des fichiers F
If F <> ThisWorkbook.Name Then 'condition : si F n'est pas le fichier destination
Set CS = Application.Workbooks.Open(CA & F) 'définit le classeur source CS en l'ouvrant
Set OS = CS.Worksheets(1) 'définit l'onglet source (ici le premier, à adapter à ton cas)
DL = OS.Cells(Application.Rows.Count, "B").End(xlUp).Row 'définit la dernière ligne édité DL de la colonne B de l'onglet OS <---------- ICI
NL = DL - 9 'définit le nombrfe de lignes NL du classeur source <---------- ICI
Set R = TS.ListColumns(1).Range.Find("") 'définit la recherche R (recherche du vide dans la colonne 1 de TS)
If R Is Nothing Or TS.ListRows.Count = 0 Then 'condition : si aucune occurrence n'est trouvée
TS.ListRows.Add 'ajoute une ligne à TS
LI = TS.ListRows.Count 'définit la ligne LI (dernière ligne de TS)
Else 'sinon
LI = R.Row - TS.HeaderRowRange.Row 'définit la ligne LI (ligne de la première occurrence trouvée moins la ligne des entête)
End If 'fin de la condition
TS.Resize TS.Range.Resize(TS.ListRows.Count + NL, TS.ListColumns.Count) 'redimensionne le tableau TS <---------- ICI
'copie les données du classeur source dans la ligne LI, colonne 1 de TS
OS.Range("B10:Q" & DL).Copy TS.DataBodyRange(LI, 1) < ----------ICI
CS.Close False 'ferme la classeur source sans enregistrer
End If 'fin de la condition
F = Dir 'définit le prochain fichier F ayant CA comme chemin d'accès
Loop 'boucle
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
MsgBox "Données traitées !" 'message
End Sub