Compléter un tableau Excel depuis des fichiers Excels

Question

Je souhaite compléter automatiquement les lignes du Fichier : Fichier tableau issu du cumul de fichier base, à partir des informations du Fichier : Fichier base. Il faut bien entendu que les informations rapportées sur le Fichier : Fichier tableau issu du cumul de fichier base, viennent se mettre les unes à la suite des autres sans les écraser après chaque enregistrement. Le nom du Fichier : Fichier base sera différent à chaque fois. Je souhiate pouvoir sélectionner soit le dossier où ces fichiers Excel se trouvent, soit plusieurs fichiers à la fois et ensuite lancer le traitement (remplissage du Fichier : Fichier tableau issu du cumul de fichier base). PS : Les informations à rapportées sont soit du texte soit le texte se trouvant à gauche d'une cellule marquée d'un X. Attention, si pour une meme caractéristique (Caractéristique 1 par exemple), les deux cellules de gauche doivent s'affichées et etre rapportées). Si vous souhaitez plus d'informations n'hésitez pas. Par avance, un grand merci...

PhilParis · Answer

Le problème que tu soumet est plutôt typique d'une base de données que d'excel. As tu envisagé l'utilisation d'un SGBD pour construire ton tableau de données cible ? Sinon VBA devrait pouvoir t'aider à faire ce que tu veux, regarde les fonctions macro d'ouverture de fichiers (pour tes fichiers de données base) et les fonctions de recherche et sélection (pour lire les données, sélectionner une ligne vide et filtrer sur tes critères). Tu dois pouvoir réaliser un petit script qui va chercher tes fichiers bases en paramètres, lit leur contenu enregistrement par enregistrement (une ligne de ton tableau cible), contrôle ce contenu et l'inscrit dans une nouvelle ligne de ton tableau cible. Si cela peut t'aider à avancer, Cordialement...

migou · Answer

Voici un code, le dossier à sélectionner ne doit évidemment contenir que les fichiers de base (toujours identiques). Sub traiter() Dim fso, fichier, fichiers Dim wkb As Workbook Dim choix_chemin As FileDialog Dim ligne_copie As Long ' Récupération des répertoires Set choix_chemin = Application.FileDialog(msoFileDialogFolderPicker) choix_chemin.Show Set fso = CreateObject("Scripting.FileSystemObject") Set Dossier = fso.GetFolder(choix_chemin.SelectedItems(1)) Set fichiers = Dossier.Files Set choix_chemin = Nothing ' Boucle sur les fichiers For Each fichier In fichiers Set wkb = Workbooks.Open(fichier) ligne_copie = ThisWorkbook.Worksheets("Feuil1").Range("A" &amp; Rows.Count).End(xlUp).Row + 1 With ThisWorkbook.Worksheets("Feuil1") .Range("A" &amp; ligne_copie).Value = wkb.Worksheets("Feuil1").Range("B2").Value .Range("B" &amp; ligne_copie).Value = wkb.Worksheets("Feuil1").Range("B3").Value .Range("C" &amp; ligne_copie).Value = wkb.Worksheets("Feuil1").Range("B4").Value .Range("D" &amp; ligne_copie).Value = wkb.Worksheets("Feuil1").Range("B5").Value .Range("E" &amp; ligne_copie).Value = wkb.Worksheets("Feuil1").Range("B6").Value For ligne = 8 To 10 If Not IsEmpty(wkb.Worksheets("Feuil1").Cells(ligne, 3)) Then .Cells(ligne_copie, 6).Value = wkb.Worksheets("Feuil1").Cells(ligne, 2).Value Exit For End If Next For ligne = 12 To 13 If Not IsEmpty(wkb.Worksheets("Feuil1").Cells(ligne, 3)) Then .Cells(ligne_copie, 7).Value = wkb.Worksheets("Feuil1").Cells(ligne, 2).Value Exit For End If Next End With wkb.Close Set wkb = Nothing Next Set fso = Nothing Set Dossier = Nothing Set fichiers = Nothing End Sub...

migou · Answer

Code modifié :

Sub traiter()

Dim fso, fichier, fichiers
Dim wkb As Workbook
Dim choix_chemin As FileDialog
Dim ligne_copie As Long
Dim fruit As String

' Récupération des répertoires

Set choix_chemin = Application.FileDialog(msoFileDialogFolderPicker)
choix_chemin.Show

Set fso = CreateObject("Scripting.FileSystemObject")
Set Dossier = fso.GetFolder(choix_chemin.SelectedItems(1))
Set fichiers = Dossier.Files
Set choix_chemin = Nothing

' Boucle sur les fichiers

For Each fichier In fichiers
    Set wkb = Workbooks.Open(fichier)
    ligne_copie = ThisWorkbook.Worksheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row + 1

    With ThisWorkbook.Worksheets("Feuil1")

        .Range("A" & ligne_copie).Value = wkb.Worksheets("Feuil1").Range("B2").Value
        .Range("B" & ligne_copie).Value = wkb.Worksheets("Feuil1").Range("B3").Value
        .Range("C" & ligne_copie).Value = wkb.Worksheets("Feuil1").Range("B4").Value
        .Range("D" & ligne_copie).Value = wkb.Worksheets("Feuil1").Range("B5").Value
        .Range("E" & ligne_copie).Value = wkb.Worksheets("Feuil1").Range("B6").Value

        fruit = ""

        For ligne = 8 To 10
            If Not IsEmpty(wkb.Worksheets("Feuil1").Cells(ligne, 3)) Then
                If fruit = "" Then
                    fruit = wkb.Worksheets("Feuil1").Cells(ligne, 2).Value
                Else: fruit = fruit & " / " & wkb.Worksheets("Feuil1").Cells(ligne, 2).Value
                End If
            End If
        Next

        .Cells(ligne_copie, 6).Value = fruit

        fruit = ""
        For ligne = 12 To 13
            If Not IsEmpty(wkb.Worksheets("Feuil1").Cells(ligne, 3)) Then
                If fruit = "" Then
                    fruit = wkb.Worksheets("Feuil1").Cells(ligne, 2).Value
                Else: fruit = fruit & " / " & wkb.Worksheets("Feuil1").Cells(ligne, 2).Value
                End If
            End If
        Next

        .Cells(ligne_copie, 7).Value = fruit

    End With

    wkb.Close
    Set wkb = Nothing
Next

Set fso = Nothing
Set Dossier = Nothing
Set fichiers = Nothing

End Sub

J'espère que ça répond à ta demande

PhilParis · Answer

Tu l'as demandé, Migou la fait. Beau travail Migou. Si c'est OK pour toi, Raf, clos le sujet (la petite coche à côté du bouton éditer), il servira de référence à d'autres. Cordialement, PhilParis...

migou · Answer

Tu l'as demandé, Migou la fait. Beau travail Migou. Si c'est OK pour toi, Raf, clos le sujet (la petite coche à côté du bouton éditer), il servira de référence à d'autres. Cordialement, PhilParis Merci PhilParis...