Extraction de données depuis plusieurs fichier Excel vers un seul global

Le 21/11/2019 à 21:46

Bonjour , plutôt bonsoir

Je vise comme l'indique le titre,à extraire des données de plusieurs fichiers excel (qui se trouvent dans des chemins d’accès différents) vers un seul fichier servant comme bilan ou synthèse

En Effet, j'ai plusieurs fichiers excel répartis sur 3 dossiers (Vente, Achat, Location)

Chacun de ces dossiers contient des fichiers excel ( .xls ; .xlsx et .xlsm)

J'ai besoin de synthétiser,avec macro, dans un fichier excel nommé BILAN le contenue,personnalisé*, de chacun des fichiers des 3 dossiers

*contenue personnalisé: preciser les cellules à extraire dans le code VBA, car les fichiers ne sont pas toujours de la même structure

par exemple:

Ventes Chiffre Achat Chiffre Location Chiffre

Clt1 125 AA1 200 BB1 302

Clt2 225 AA2 300 BB2 3402

Clt3 745 AA3 230 BB3 342

Clt4 305 AA4 205 BB4 3025

Clt5 108 AA5 500 BB5 352

Clt6 685 AA6 660 BB6 602

Puis-je avoir de l'aide ?

Le 22/11/2019 à 09:25

Bonjour Sgh.Chafaa, bonjour le forum,

Sgh.Chafaa a écrit :

Puis-je avoir de l'aide ?

Si tu daignais nous fournir un exemple (fichiers) et des précisions (chemins, critères, etc.), tu en aurais certainement...

Le 22/11/2019 à 17:17
ThauThème a écrit :

Bonjour Sgh.Chafaa, bonjour le forum,

Sgh.Chafaa a écrit :

Puis-je avoir de l'aide ?

Si tu daignais nous fournir un exemple (fichiers) et des précisions (chemins, critères, etc.), tu en aurais certainement...

Bonsoir,

Je m'excuse que l'explication n’était pas claire,

Ci-Joint le dossier avec simulation du resultat

(le Dossier "Dossiers TEST" est directement placé sur le racine C: lors de ma simulation)

30dossiers-test.zip (85.27 Ko)
Le 23/11/2019 à 12:38

Bonjour Cgh.Chafaa, bonjour le forum,

En pièce jointe ton fichier modifié avec le code full comment. Clique sur le bouton Récup.. Les anciennes données sont effacées mais on pourra le changer si ça va pas...

Le code :

Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim CAP As String 'déclare la variable CAP (Chemin d'Accès Principal)
Dim CAD(1 To 3) As String 'déclare le tableau de 3 variables CAD (Chemin d'Acces des Dossiers)
Dim D As Byte 'déclare la variable D (incrément de Dossier)
Dim F As String 'déclare la variable F (Fichier)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim PL As Range 'déclare la variable PL (PLage)
Dim NL As Integer 'déclare la variable NL (Nombre de Lignes)
Dim NAS As Byte 'déclare la variable NAS (Nombre d'Anti Slash)

Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Worksheets("Feuil1") 'définit l'onglet destination OD
OD.UsedRange.Offset(1, 0).EntireRow.Delete 'efface d'éventuelles anciennes données (je ne sais pas si tu veux ça ou pas...)
Application.ScreenUpdating = False 'masque les rafraîchissements de l'écran
CAP = CD.Path & "\" 'définit le chemin d'accès principal CAP
CAD(1) = CAP & "Achats\" 'définit le chemin d'accès CAD(1) Achats
CAD(2) = CAP & "Locations\" 'définit le chemin d'accès CAD(2) Locations
CAD(3) = CAP & "Ventes\" 'définit le chemin d'accès CAD(3) Ventes
For D = 1 To 3 'boucle 1 : sur les 3 dossiers D
    F = Dir(CAD(D) & "*.xls*") 'définit le premier fichiers Excel F ayant CAD(D) commme chemin d'accès
    Do While F <> "" 'boucle tant qu'il existe des fichiers F
        Set CS = Workbooks.Open(CAD(D) & F) 'définit le classeur source CS en l'ouvrant
        Set OS = CS.Worksheets("Feuil1") 'définit l'onglet source OF
        Set DEST = OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST
        Set PL = OS.Range("A1").CurrentRegion 'définit la plage PL de l'onglet source
        Set PL = PL.Offset(1, 0).Resize(PL.Rows.Count - 1, PL.Columns.Count) 'redéfinit la plage PL sans la première ligne
        NL = PL.Rows.Count 'définit le nombre de lignes NL de la plage PL
        NAS = UBound(Split(CAD(D), "\")) 'définit le nombre NAS d'anti slash (\) contenus dans le dossier CAD(D)
        DEST.Resize(NL, 1).Value = Split(CAD(D), "\")(NAS - 1) 'renvoie dans la colonne A le dernier mot du nom du dossier CAD(D)
        DEST.Offset(0, 1).Resize(NL, 1).Value = Split(F, ".")(0) 'renvoie dans la colonne B le nom du fichier F sans l'extension
        PL.Copy DEST.Offset(0, 2) 'copie la plage PL et la colle dans DEST décalée de deux colonnes à droite
        CS.Close False 'ferme le classeur source sans l'enregistrer
        F = Dir 'définit le prochain fichier Excel F ayant CAD(D) commme chemin d'accès
    Loop 'boucle
Next D 'prochain dossier de la boucle 1

'**********************************
'Mise en forme bordures et couleurs
'**********************************
OD.Activate 'active l'onglet OD (normalement ce n'est pas nécessaire mais au cas où...)
Set PL = OD.Range("A1").CurrentRegion 'redéfinit la plage PL
'bordures
PL.Borders(xlEdgeTop).LineStyle = xlContinuous
PL.Borders(xlEdgeBottom).LineStyle = xlContinuous
PL.Borders(xlEdgeRight).LineStyle = xlContinuous
PL.Borders(xlEdgeLeft).LineStyle = xlContinuous
PL.Borders(xlInsideVertical).LineStyle = xlContinuous
PL.Borders(xlInsideHorizontal).LineStyle = xlContinuous
Set PL = PL.Offset(1, 0).Resize(PL.Rows.Count - 1, PL.Columns.Count) 'redéfinit la plage PL sans la première ligne
With PL.Columns(1).Interior 'couleur colonne 1
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
End With
With PL.Columns(2).Interior 'couleur colonne 2
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
End With
With Application.Intersect(PL, OD.Columns("C:H")).Interior 'couleur colonne 3 à 8
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
End With
Application.ScreenUpdating = True 'affiche les rafraîchissements de l'écran
MsgBox "Traitement des données terminé !"
End Sub

Le fichier (devenu .xlsm à cause de la macro) :

43bilan.xlsm (24.44 Ko)
Le 25/11/2019 à 09:50

[quote=ThauThème post_id=814642 time=1574509120 user_id=31038]

Bonjour Cgh.Chafaa, bonjour le forum,

En pièce jointe ton fichier modifié avec le code full comment. Clique sur le bouton Récup.. Les anciennes données sont effacées mais on pourra le changer si ça va pas...

Bonjour M. ThauThème,

c'est formidable ce que vous avez générer comme code !!

pour moi c de la magie !

merci énormément pour tout le temps et l'effort que vous avez consacrer pour moi

en plus les commentaires ! c'est génial

reste une petite remarque, les tableaux sources ne sont pas de la même structure, donc parfois j'ai besoin de "préciser" manuellement le cellule destination, avec notre exemple actuel, sinon peut être avec les nom des plages si on cherche quelque chose plus automatisé (colonne date source-->colonne date destination)

ci-joint un explicatif d'incompatibilité des champs dans le fichier global "Bilan"

20explicatif-bilan.xlsx (18.46 Ko)
Le 25/11/2019 à 09:51

Bonjour M. ThauThème,

c'est formidable ce que vous avez générer comme code !!

pour moi c de la magie !

merci énormément pour tout le temps et l'effort que vous avez consacrer pour moi

en plus les commentaires ! c'est génial

reste une petite remarque, les tableaux sources ne sont pas de la même structure, donc parfois j'ai besoin de "préciser" manuellement le cellule destination, avec notre exemple actuel, sinon peut être avec les nom des plages si on cherche quelque chose plus automatisé (colonne date source-->colonne date destination)

ci-joint un explicatif d'incompatibilité des champs dans le fichier global "Bilan"

18explicatif-bilan.xlsx (18.46 Ko)
Le 25/11/2019 à 10:57

Re,

Oui je m'en étais rendu compte après coup. Chaque fichier étant différent je crains qu'il ne faille créer une usine à gaz pour arriver à tes fins... Je me demande s'il ne vaudrait pas mieux modifier les fichiers source avant de récupérer les données ou bien de modifier le fichier final à chaque importation. Quoi qu'il en soit cela va me prendre du temps. Il te faudra être patient je vais essayer de trouver une solution...

Le 25/11/2019 à 15:34

Re,

J'ai ouvert les différents fichiers et je vois qu'ils ont des structures différente. Après mûre réflexion je ne vais pas chercher à coder, trop complexe ! Quand on veux récupérer les données de plusieurs fichiers on prend soins à ce qu'elles aient toutes la même structure. Il ne te restera plus qu'à ajuster dans le fichier final en décalant certaine colonne dans certaines lignes. Désolé...

Le 25/11/2019 à 17:28
ThauThème a écrit :

Re,

J'ai ouvert les différents fichiers et je vois qu'ils ont des structures différente. Après mûre réflexion je ne vais pas chercher à coder, trop complexe ! Quand on veux récupérer les données de plusieurs fichiers on prend soins à ce qu'elles aient toutes la même structure. Il ne te restera plus qu'à ajuster dans le fichier final en décalant certaine colonne dans certaines lignes. Désolé...

Vous avez toute à fait raison c trop compliqué

par contre si possible, per favore, comment parcourir toutes les fichiers pour récupérer (en valeur) une/des cellule bien précise

par exemple parcourir toutes les fichiers du dossier donnée pour récuperer la cellule B3 et C4 par exmple el les mettre dans un fichier recap B3 (source) --> A1 Destination et C4 (source) --> A2 (destination)

puis je ferais un code personnalisé à mon besoin, programmation statique

Le 26/11/2019 à 09:48

Re,

Ça donnerait ça :

Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim CAP As String 'déclare la variable CAP (Chemin d'Accès Principal)
Dim CAD(1 To 3) As String 'déclare le tableau de 3 variables CAD (Chemin d'Acces des Dossiers)
Dim D As Byte 'déclare la variable D (incrément de Dossier)
Dim F As String 'déclare la variable F (Fichier)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Worksheets("Feuil1") 'définit l'onglet destination OD
OD.UsedRange.Offset(1, 0).EntireRow.Delete 'efface d'éventuelles anciennes données (je ne sais pas si tu veux ça ou pas...)
Application.ScreenUpdating = False 'masque les rafraîchissements de l'écran
CAP = CD.Path & "\" 'définit le chemin d'accès principal CAP
CAD(1) = CAP & "Achats\" 'définit le chemin d'accès CAD(1) Achats
CAD(2) = CAP & "Locations\" 'définit le chemin d'accès CAD(2) Locations
CAD(3) = CAP & "Ventes\" 'définit le chemin d'accès CAD(3) Ventes
For D = 1 To 3 'boucle 1 : sur les 3 dossiers D
    F = Dir(CAD(D) & "*.xls*") 'définit le premier fichiers Excel F ayant CAD(D) commme chemin d'accès
    Do While F <> "" 'boucle tant qu'il existe des fichiers F
        Set CS = Workbooks.Open(CAD(D) & F) 'définit le classeur source CS en l'ouvrant
        Set OS = CS.Worksheets("Feuil1") 'définit l'onglet source OF
        Set DEST = OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST
        DEST.Value = OS.Range("B3").Value 'récupère dans DEST la valeur de B3
        DEST.Offset(1, 0).Value = OS.Range("C4").Value 'récupère dans DEST décalée d'une ligne vers le bas la valeur de C4
        CS.Close False 'ferme le classeur source sans l'enregistrer
        F = Dir 'définit le prochain fichier Excel F ayant CAD(D) commme chemin d'accès
    Loop 'boucle
Next D 'prochain dossier de la boucle 1
End Sub
Le 26/11/2019 à 17:32
ThauThème a écrit :

Re,

Ça donnerait ça :

Je ne sais pas comment vous remercier monsieur ThauThème

Que de bonheur pour vous

Rechercher des sujets similaires à "extraction donnees fichier seul global"