Créer un fichier de synthese à partir de plusieurs fichiers

Le 05/09/2011 à 10:12

Bonjour à tous,

Je souhaite compiler des données de différents fichiers excel pour faire une synthese via une partie du nom du fichier et des données de ce fichier.

Ces fichiers seront tous dans un dossier dont le nom ( du dossier ) sera le premier critere à récupérer (Le nom et le nombre des dossiers sources sont connus).

Le second critere à récupérer sera une partie du nom du fichier : Fournisseur (Les fichiers sont nommés de la manière suivante :SITE_FOURNISSEUR.)

Le nombre de fichier dans le dossier n’est pas connu à l’avance.

La macro devra donc créer une ligne par fichier dans le fichier "SYNTHESE" avec le nom du dossier (site), la deuxieme partie du nom du fichier (fournisseur) puis des données du fichier et ensuite basculé sur le fichier suivant, puis le dossier suivant.

J'ai joint le fichier SYNTHESE et le fichier SITE_FOURNISSEUR.

Dans l'attente d'un (gros) coup de main,

Merci d'avance,

288synthese-groupe.xlsx (20.67 Ko)
276site-fournisseur.zip (13.85 Ko)
Le 05/09/2011 à 11:33

Bonjour lanfeust,

Maintenant que le principe est posé, peux-tu donner un exemple concret ? Car il y a quelques points à éclaircir.

lanfeust76 a écrit :

Ces fichiers seront tous dans un dossier dont le nom ( du dossier ) sera le premier critere à récupérer

On le récupère d'où ?

Les fichiers Fournisseur ont tous exactement la même structure ? Les données à récupérer sont toutes en ligne 30 ?

lanfeust76 a écrit :

puis des données du fichier et ensuite basculé sur le fichier suivant, puis le dossier suivant.

Il y a plusieurs dossiers dans le dossier dont on a récupéré le nom au début ?
Le 05/09/2011 à 12:38

Déja merci de prende en comtpe mon probleme car j'essaye de me lancer tout seul mais la je bloque !

lanfeust76 a écrit :

Ces fichiers seront tous dans un dossier dont le nom ( du dossier ) sera le premier critere à récupérer

On le récupère d'où ? On le récupére du nom du fichier "SITE_FOURNISSEUR" : SITE pour le site et FOURNISSEUR pour le founisseur (attention la casse du nom du fichier n'est pas figé, il faut la modifier pour que cela fonctionne mieux.)

Les fichiers Fournisseur ont tous exactement la même structure ? Les données à récupérer sont toutes en ligne 30 ?

Les fichiers Fournisseur ont tous exactement la même structure ? Les données à récupérer sont toutes en ligne 30 ?

Oui il s'agit du fichier type il seront tous créer à partir de celui la et oui les données seront toutes en ligne 30.

lanfeust76 a écrit :

puis des données du fichier et ensuite basculé sur le fichier suivant, puis le dossier suivant.

Il y a plusieurs dossiers dans le dossier dont on a récupéré le nom au début ?[/quote]

Il y a 6 dossiers ( nommés avec 3 lettres correspondant au site) qui contiennent tous un nombre aléatoire de fichiers "SITE_FOURNISSEUR".

Le 05/09/2011 à 13:19
lanfeust76 a écrit :

On le récupére du nom du fichier "SITE_FOURNISSEUR"

Le problème est qu'avant de récupérer le nom de dossier à partir du nom du fichier "SITE_FOURNISSEUR", il faut savoir où se trouve ce fichier pour faire un traitement dessus ! A moins que je n'aie mal compris ?!

C'est pour ça que je t'ai demandé un exemple concret. Avec les répertoires et chemins de tes fichiers/dossiers...

Le 05/09/2011 à 13:39
vba-new a écrit :
lanfeust76 a écrit :

On le récupére du nom du fichier "SITE_FOURNISSEUR"

Le problème est qu'avant de récupérer le nom de dossier à partir du nom du fichier "SITE_FOURNISSEUR", il faut savoir où se trouve ce fichier pour faire un traitement dessus ! A moins que je n'aie mal compris ?!

C'est pour ça que je t'ai demandé un exemple concret. Avec les répertoires et chemins de tes fichiers/dossiers...

Ci-joint un word avec descriptif de l'emplacement des dossiers (fichier arborescence)

235arborescence.docx (173.06 Ko)
Le 05/09/2011 à 13:53

Ok. Je crois avoir compris.

Maintenant pour les différentes données à rapatrier. Pour les champs suivants : Conformité, Délai, Quantité, Documents, Services.

On doit prendre le champ nb liv NC ou Coeff du fichier SITE_FOURNISSEUR ?

Le 05/09/2011 à 13:58

Les données à rapatrier sont "Nombre totale de livraison" B30 , nombre de livraison NC" C30 et "Cotation fournisseur" N30

Le 05/09/2011 à 14:32

Une macro à mettre dans le fichier de synhèse et à tester :

Sub synthese()
    Dim Maitre As Workbook
    Dim Rep As String, NomRep$, racine$, site$, fournisseur$
    Dim i As Long
    Dim fs, dossier, f

    Application.ScreenUpdating = False
    Set Maitre = ThisWorkbook
    Rep = Maitre.Path & "\"
    NomRep = Dir(Rep, vbDirectory)
    i = Range("a" & Rows.Count).End(xlUp).Row + 1
    Do While NomRep <> ""
        If NomRep <> "." And NomRep <> ".." Then
            'test si répertoire ou non
            If (GetAttr(Rep & NomRep) And vbDirectory) = vbDirectory Then
                racine = Rep & NomRep
                Set fs = CreateObject("Scripting.FileSystemObject")
                Set dossier = fs.getfolder(racine)    'DossierRacine
                For Each f In dossier.Files
                    site = Left(f.Name, InStr(f.Name, "_") - 1)
                    fournisseur = Replace(Replace(f.Name, ".xls", ""), site & "_", "")
                    Workbooks.Open (f.Path)    'ouvre le fichier fournisseur
                    nbLivr = [b30]: nbLivrConf = [c30]: cotation = [n30]
                    ActiveWorkbook.Close False    'ferme le fichier actif sans sauvegarder
                    With Maitre.Sheets("SYNTHESE")
                        .Cells(i, 1) = fournisseur
                        .Cells(i, 2) = site
                        .Cells(i, 3) = nbLivr
                        .Cells(i, 4) = nbLivrConf
                        .Cells(i, 6) = cotation
                    End With
                    i = i + 1
                Next
            End If
        End If
        NomRep = Dir
    Loop
End Sub
Le 05/09/2011 à 15:29

Alors j'ai fait le test avec deux fichiers de données :

j'ai ajouté le fichier en piece jointe

1- Quand je lance la macro la1iere fois il met le message suivant : "Un fichier nommé "chemin/nom du fichier" existe deja a cet emplacement. Voulez vous le remplacer?"

Peux t'on supprimer ce message?

2- J'ai créé trois fichiers test dans le dossier "AND" , A, B et C et trois autres fichiers test dans le dossier "LIS" A, B et C

Quand je lance la premiere fois la macro, j'ai les données suivantes qui sont récupérés :

AND B, AND C, LIS A, LIS B et LIS C (voir cellule en jaune)

par contre si je relance la macro, il prendles 6 fichiers AND A, AND B, AND C, LIS A, LIS B et LIS C (voir cellule en vert)

3- Les noms des fournisseurs sont tous suivuis d'un "x" collés à leur nom, peux t'on les supprimer?

De plus je souhaiterais commencer par un RAZ du tableau, est ce possible ?

191synthese-groupe.xlsm (31.19 Ko)
Le 05/09/2011 à 16:21

Re,

Pour enlever le message du point 1, utilise l'instruction

Application.DisplayAlerts = False

Pour le point 2, c'est parce que tu as des cellules fusionnées.

La macro suivante corrige les 3 points et fait un RAZ du tableau :

Sub Eval_groupe()
'
' Eval_groupe Macro
' Compilation sdes évaluations site
'
    Dim Maitre As Workbook
    Dim Rep As String, NomRep$, racine$, site$, fournisseur$
    Dim i As Long
    Dim fs, dossier, f

    Application.ScreenUpdating = False    'désactive mise à jour écran
    Application.DisplayAlerts = False    'évite les messages d'alerte
    Set Maitre = ThisWorkbook
    Rep = Maitre.Path & "\"
    NomRep = Dir(Rep, vbDirectory)
    Range("A6:A" & Range("a" & Rows.Count).End(xlUp).Row + 1).EntireRow.ClearContents    'efface les données de synthèse
    i = 6
    Do While NomRep <> ""
        If NomRep <> "." And NomRep <> ".." Then
            'test si répertoire ou non
            If (GetAttr(Rep & NomRep) And vbDirectory) = vbDirectory Then
                racine = Rep & NomRep
                Set fs = CreateObject("Scripting.FileSystemObject")
                Set dossier = fs.getfolder(racine)    'DossierRacine
                For Each f In dossier.Files
                    site = Left(f.Name, InStr(f.Name, "_") - 1)
                    fournisseur = Replace(Replace(f.Name, "x.xls", ""), site & "_", "")
                    Workbooks.Open (f.Path)    'ouvre le fichier fournisseur
                    nbLivr = [b30]: nbLivrConf = [c30]: cotation = [n30]
                    ActiveWorkbook.Close False    'ferme le fichier actif sans sauvegarder
                    With Maitre.Sheets("SYNTHESE")
                        .Cells(i, 1) = fournisseur
                        .Cells(i, 2) = site
                        .Cells(i, 3) = nbLivr
                        .Cells(i, 4) = nbLivrConf
                        .Cells(i, 6) = cotation
                    End With
                    i = i + 1
                Next
            End If
        End If
        NomRep = Dir
    Loop

    ChDir "S:\Groups\EMB_Qualite\ACHATS\EVALUATION FOURNISSEURS"
    ActiveWorkbook.SaveAs Filename:= _
        "S:\Groups\EMB_Qualite\ACHATS\EVALUATION FOURNISSEURS\SYNTHESE GROUPE.xlsm", _
        FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub
Le 05/09/2011 à 16:34

Ca bloque au niveau de la ligne de commande suivante :

vba-new a écrit :

Sub Eval_groupe()

'

' Eval_groupe Macro

' Compilation sdes évaluations site

'

Dim Maitre As Workbook

Dim Rep As String, NomRep$, racine$, site$, fournisseur$

Dim i As Long

Dim fs, dossier, f

Application.ScreenUpdating = False 'désactive mise à jour écran

Application.DisplayAlerts = False 'évite les messages d'alerte

Set Maitre = ThisWorkbook

Rep = Maitre.Path & "\"

NomRep = Dir(Rep, vbDirectory)

Range("A6:A" & Range("a" & Rows.Count).End(xlUp).Row + 1).EntireRow.ClearContents 'efface les données de synthèse

i = 6

Do While NomRep <> ""

If NomRep <> "." And NomRep <> ".." Then

'test si répertoire ou non

If (GetAttr(Rep & NomRep) And vbDirectory) = vbDirectory Then

racine = Rep & NomRep

Set fs = CreateObject("Scripting.FileSystemObject")

Set dossier = fs.getfolder(racine) 'DossierRacine

For Each f In dossier.Files

site = Left(f.Name, InStr(f.Name, "_") - 1)

fournisseur = Replace(Replace(f.Name, "x.xls", ""), site & "_", "")

Workbooks.Open (f.Path) 'ouvre le fichier fournisseur

nbLivr = [b30]: nbLivrConf = [c30]: cotation = [n30]

ActiveWorkbook.Close False 'ferme le fichier actif sans sauvegarder

With Maitre.Sheets("SYNTHESE")

.Cells(i, 1) = fournisseur

.Cells(i, 2) = site

.Cells(i, 3) = nbLivr

.Cells(i, 4) = nbLivrConf

.Cells(i, 6) = cotation

End With

i = i + 1

Next

End If

End If

NomRep = Dir

Loop

ChDir "S:\Groups\EMB_Qualite\ACHATS\EVALUATION FOURNISSEURS"

ActiveWorkbook.SaveAs Filename:= _

"S:\Groups\EMB_Qualite\ACHATS\EVALUATION FOURNISSEURS\SYNTHESE GROUPE.xlsm", _

FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

End Sub

Par contre maintenant j'ai plus de x derriere le nom du fournisseur mais .xlsx...

Merci vraiment de ce coup de main !

Le 05/09/2011 à 16:59
lanfeust76 a écrit :

Ca bloque au niveau de la ligne de commande suivante :

Quelle est l'erreur retournée ?
lanfeust76 a écrit :

Par contre maintenant j'ai plus de x derriere le nom du fournisseur mais .xlsx...

Ce sont des fichiers xlsx ? Le fichier fournisseur que tu avais joint était au format xls.

Remplace la ligne

fournisseur = Replace(Replace(f.Name, "x.xls", ""), site & "_", "")

par celle-ci :

fournisseur = Replace(Replace(f.Name, ".xlsx", ""), site & "_", "")

Edit : Je pense que l'erreur provient des cellules fusionnées. Réessaie avec ce code :

Sub Eval_groupe()
'
' Eval_groupe Macro
' Compilation sdes évaluations site
'
    Dim Maitre As Workbook
    Dim Rep As String, NomRep$, racine$, site$, fournisseur$
    Dim i As Long, derlign&
    Dim fs, dossier, f

    Application.ScreenUpdating = False    'désactive mise à jour écran
    Application.DisplayAlerts = False    'évite les messages d'alerte
    Set Maitre = ThisWorkbook
    Rep = Maitre.Path & "\"
    NomRep = Dir(Rep, vbDirectory)
    derlign = IIf(Range("a" & Rows.Count).End(xlUp).Row + 1 = 5, 6, Range("a" & Rows.Count).End(xlUp).Row + 1)
    Range("A6:A" & derlign).EntireRow.ClearContents    'efface les données de synthèse
    i = 6
    Do While NomRep <> ""
        If NomRep <> "." And NomRep <> ".." Then
            'test si répertoire ou non
            If (GetAttr(Rep & NomRep) And vbDirectory) = vbDirectory Then
                racine = Rep & NomRep
                Set fs = CreateObject("Scripting.FileSystemObject")
                Set dossier = fs.getfolder(racine)    'DossierRacine
                For Each f In dossier.Files
                    site = Left(f.Name, InStr(f.Name, "_") - 1)
                    fournisseur = Replace(Replace(f.Name, ".xlsx", ""), site & "_", "")
                    Workbooks.Open (f.Path)    'ouvre le fichier fournisseur
                    nbLivr = [b30]: nbLivrConf = [c30]: cotation = [n30]
                    ActiveWorkbook.Close False    'ferme le fichier actif sans sauvegarder
                    With Maitre.Sheets("SYNTHESE")
                        .Cells(i, 1) = fournisseur
                        .Cells(i, 2) = site
                        .Cells(i, 3) = nbLivr
                        .Cells(i, 4) = nbLivrConf
                        .Cells(i, 6) = cotation
                    End With
                    i = i + 1
                Next
            End If
        End If
        NomRep = Dir
    Loop

    ChDir "S:\Groups\EMB_Qualite\ACHATS\EVALUATION FOURNISSEURS"
    ActiveWorkbook.SaveAs Filename:= _
        "S:\Groups\EMB_Qualite\ACHATS\EVALUATION FOURNISSEURS\SYNTHESE GROUPE.xlsm", _
        FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub
Le 05/09/2011 à 17:27

Ok

Tout fonctionne je vais faire quelques modif tout seul je pense avori piger l'essentiel

Merci encore pour ce (gros) coup de main

Le 16/09/2011 à 01:51

j'ai le même problème, j'avoue que je suis novice en Excel

mes fichiers sont numérotés de 1001 à l'infini car ça ne cesse de croitre, mais ils sont tous sous le même format.

je souhaiterais récupérer certaines cellules, soit D4, E6, F9,... dans un autre fichier de synthèse sous forme de tableau où sous l'onglet A1 figurent tous les noms de fichiers dans l'ordre, sous B1 figurent la valeur de D4 des différents fichiers les unes après les autres, pareil que sous C1 la valeur de E6, ainsi de suite...

si possible dans la dernière colonnes les dernières dates de modification. SVP aidez moi, je suis dans l'impasse

Le 16/09/2011 à 10:01

Bonjour djowen,

Ouvre un autre post plutôt, c'est plus clair et tu auras plus de chance d'obtenir plus d'aide.

Le 16/09/2011 à 10:23

ok, je comprends! mais j'ai pas cette possibilté

Le 16/09/2011 à 10:35
djowen a écrit :

mais j'ai pas cette possibilté

Qu'entends-tu par là ?
Rechercher des sujets similaires à "creer fichier synthese partir fichiers"