Création base de données à partir de fichiers multiples Résolu

Question

Bonjour à tous, 

J'ai besoin de votre aide pour regrouper les données de dizaines de fichier dans un seul. 
Je m'explique, 1 fois par semaine (+/-) un nouveau fichier Excel est créé par une macro qui reprend l’intégralité des déchets évacuer sur cette semaine à partir d’un encodage manuelle.
Le nom du fichier est toujours le même : « Enlèvement [NomRepreneur] du [Date].xlsx » voici un exemple : Enlèvement IndusEnvi du 9-Dec.-15.xlsx
Tous les fichiers sont stockés dans un seul et même folder qui ne contient que ces fichiers en question  U:\Déchets\Enlèvements
Le fichier fonctionne également toujours de la même façon :
-	2 onglets : Sheet1 & Sheet2 (Seul Sheet1 nous intéresse)
-	Les infos des déchets sont toujours entre A6 et I30

Mon souci est que aujourd’hui je dois faire le total des déchets évacuer sur l’année dernière, j’ai donc deux solutions : 
1.	Reprendre tous les fichiers 1 par 1 à la main (+/- 50 fichiers)
2.	Créer une macro qui copie toutes ces données sur un nouveau fichier
Personnellement je préfère la solution numéro 2 mais j’ai besoin d’aide pour ça.

Pour résumer la macro doit récupérer la plage A6 :I30 sur le premier fichier « enlèvement » coller ces informations sur un autre fichier vierge, appelons le « Total », sur la plage A6 :I30 puis copier les informations de la plage A6 :I30 du second fichier « Enlèvement » pour revenir le coller à la suite du fichier « Total » soit de A31 à I55 puis copier les informations du 3ème fichier « enlèvement »  pour les coller à la suite du fichier « Total » ect… Afin d’avoir une base de données exploitables.
BONUS : Si en plus il est possible d’ajouter dans la colonne J du fichier « Total » le nom du fichier d’origine afin de connaître le nom de mon repreneur pour obtenir des stats plus précise cela serait merveilleux mais cela n’est pas indispensable en soit.

J’espère avoir été clair tout comme j’espère qu’une âme charitable aura un peu de temps pour m’aider.
Un grand merci d’avance.
Bonne journée, 
Villette.

michel_m · Answer

bonjour

voir 2 ou 3 fichiers source faciliterait le travail
pour cela
Mettre les classeurs en 1 "zip" sans données confidentielles en pièce jointe sur https://www.cjoint.com/et coller le raccourci  proposé (clic droit) dans le message de réponse 
Dans l’attente

f894009 · Answer

Bonjour,

Salut michel_m

Villette54:
une facon de faire: un fichier Modele_Total qui est enregistre Total_2016 pour cette annee et sera 2017 pour l'an prochain

dossier a decompresser, adaptez le chemin

https://www.cjoint.com/c/FACoToM7ELf


code avec commentaires (ben oui, ai un peu oublie dans le fichier)
Sub recup_infos()
    Dim TInfos, derlig, Fichier, rep
    
    rep = "D:\Déchets\Enlèvements\"
    Application.ScreenUpdating = False      'fige ecran
    Set WBT = Workbooks.Open("D:\Déchets\Modele_Total.xlsx")    'ouverture model
    With WBT.Worksheets("feuil1")
        derlig = .Cells.Find("*", , , , xlByRows, xlPrevious).Row       'derniere cellule non vide feuil1
        If derlig < 6 Then derlig = 6       'pas effacer entete si vide
        .Range("A6:J" & derlig).ClearContents       'efface derniere recup
    End With
    Fichier = Dir(rep & "Enlèvement*.xlsx")     'premier fichier
    If Fichier <> Empty Then        'fichier existe
        Do
            Workbooks.Open rep & Fichier    'ouverture fichier
            TInfos = ActiveWorkbook.Worksheets("Sheet1").Range("A6:I30").Value  'mise en memoire plage
            ActiveWorkbook.Close False      'fermeture fichier sans sauvegarde
            'edriture fichier model
            With WBT.Worksheets("feuil1")
                derlig = .Range("A" & Rows.Count).End(xlUp).Row + 1  'derniere cellule non vide +1 colonne A
                If derlig < 6 Then derlig = 6       ' si vide pour premier fichier
                .Range("A" & derlig & ":I" & derlig + 24) = TInfos      'restitution infos
                .Range("J" & derlig) = Fichier                                   'nom du fichier recupere
            End With
            Fichier = Dir       'fichier suivant
        Loop Until Fichier = Empty      'boucle jusqu'a plus de fichier
        WBT.SaveAs ("D:\Déchets\Total_" & Year(Date) & ".xlsx")     'sauvegarde avec annee en cours
        WBT.Close       'fermeture
    Else
        MsgBox "Pas de fichier dans ce repertoire: " & rep
        WBT.Close
        Exit Sub
    End If
    Application.ScreenUpdating = True
    
    MsgBox "Recuperation Ok"
End Sub

pijaku · Answer

Bonjour,

Une autre façon de faire, sans ouvrir les fichiers...
Source
Copier/Coller ce code dans un module d'un nouveau classeur :
Option Explicit

Sub ImporterDonnees()
Dim objShell As Object, objFolder As Object
Dim Chemin As String, fichier As String

Application.ScreenUpdating = False
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
If objFolder Is Nothing Then
   MsgBox "Abandon opérateur", vbCritical, "Annulation"
Else
   Cells.ClearContents
   Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & "\"
   fichier = Dir(Chemin & "*.xls")
   Do While Len(fichier) > 0
      If fichier <> ThisWorkbook.Name Then
         ThisWorkbook.Names.Add "Plage", RefersTo:="='" & Chemin & "[" & fichier & "]Sheet1'!$A$6:$I$30"
         With Sheets("Feuil2")
            .[A6:I30] = "=Plage"
            .[A6:I30].Copy
            Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Offset(2, 0).PasteSpecial xlPasteValues
            Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Offset(0, 10) = fichier
         End With
      End If
      fichier = Dir()
   Loop
   ThisWorkbook.Names("Plage").Delete
   [A1].Select
End If
End Sub

Création base de données à partir de fichiers multiples

3 réponses

Discussions similaires

Newsletters