Import données de plusieurs fichiers excel vers un fichier excel BDD

[choup67]

Bonjour à tous,

Je sais que le sujet à déjà été traité sur le forum, mais je ne sais pas faire de macros donc je n'arrive pas à adapter le code à mon cas. (sujet avec le code ici [/URL)

J'ai dans un dossier des fichiers avec une trame identique pour chaque mois. Donc dans le dossier du mois de Janvier par exemple, j'aurai plusieurs fichiers nommés :
(1).xls
(2).xls
etc.
le nombre total de fichier varie en fonction de chaque mois. 1 mois = 1 repertoire

Ci-joint un exemple du fichier type (4).xls. L'onglet formulaire correspond à ce qui est rempli et en rouge apparaissent les champs que je souhaite récupérer pour ma base de données.

Le fichier BDD correspond à la base que j'aimerai créer. Je voudrais un onglet par mois, et que pour chaque mois, excel aille dans le dossier du mois en question et recopie les données encadré en rouge pour chaque fichier qu'il trouvera.

J'espère avoir été assez claire.

Merci à tous pour votre aide

 

[choup67]

Re : Import données de plusieurs fichiers excel vers un fichier excel BDD

J'ai réussi différemment mais j'aimerai quand même trouvé un moyen de rendre les onglets variables en fonction du mois.

Pour le moment, j'ai mis en place ce code et je l'ai copié dans chaque onglet (1 onglet = 1 mois)

Private Sub cmdRecupereJanv_Click()
    Dim intFile As Integer
    Dim strWB As String
    Dim strFile As String
    Dim lgDerLig As Long
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    ' Nom du classeur actuel
    strWB = ThisWorkbook.Name
    
    lgDerLig = 2
    
    ' Récupération du premier fichier dans le répertoire
    strFile = Dir(ThisWorkbook.Path & "\01\*.xls")
    
    ' Boucle du 1er au dernier classeur dans le répertoire
    Do While strFile <> ""
        ' Si le classeur n'est pas "BDD.xlsm"
        If strFile <> strWB Then
            ' Ouvrir le fichier
            Workbooks.Open ThisWorkbook.Path & "\01\" & strFile
            
            ' Sélectionner le 2me onglet
            ActiveWorkbook.Worksheets(3).Activate
            ' Copier la 2me ligne dans le classeur Total
            'Worksheets(3).Rows("2:2").Copy Destination:=Workbooks(strWB).Worksheets("Feuil1").Range("A" & lgDerLig)
            Workbooks(strWB).Worksheets("Janvier").Range("A" & lgDerLig) = Worksheets(3).Range("A17")
            Workbooks(strWB).Worksheets("Janvier").Range("B" & lgDerLig) = Worksheets(3).Range("A20")
            Workbooks(strWB).Worksheets("Janvier").Range("C" & lgDerLig) = Worksheets(3).Range("C33")
            Workbooks(strWB).Worksheets("Janvier").Range("D" & lgDerLig) = Worksheets(3).Range("E12")
            Workbooks(strWB).Worksheets("Janvier").Range("E" & lgDerLig) = Worksheets(3).Range("D2")
            
            lgDerLig = lgDerLig + 1
            
            ' Fermeture du classeur
            Workbooks(strFile).Close
        End If
        
        ' Classeur suivant
        strFile = Dir
    Loop
    
    MsgBox "Le traitement des fichiers est terminé.", vbInformation, "Traitement..."
        
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub