Extraction de données depuis plusieurs fichier Excel

Bonjour,

Je suis en train d'élaborer une macro mais je bute sur quelques points.

J'aimerais synthétiser des classeurs, tous identiques (à part les valeurs), vers un seul et unique classeur. J'ai réussi déjà plusieurs points (exécution automatique de la macro, création du fichier contenant la synthèse, etc.). Cependant, je peine à extraire les données de plusieurs fichiers.

Pour cela, la macro doit

  • Traiter tous les classeurs excel situés dans un dossier précis
  • Récupérer pour chaque classeur les valeurs des cellules C13 à C33 de la feuille appelé "Bilan"
  • Copier/Coller les cellules vers mon classeur d'arrivé, première feuille, cellule B7 à B 27
  • Pour chaque nouveau classeur, décaler d'une colonne vers la droite

J'ai rédigé le code suivant, pour l'instant (je ne mets que la partie sur laquelle je bloque).

Bien sûr, il ne fonctionne pas. Il m'indique que la boucle "For each" ne fonctionne pas car cette boucle ne peut être itéré que sur une collection ou un tableau.

Auriez-vous des pistes pour moi ? Merci bien !

    'Partie 3 : Synthese des fichiers sources vers le fichier bilan

    Dim CheminClasseursAudits As String, ClasseurAudit As Workbook, NumeroColonne As Integer
    'Emplacement des fichiers d'audits
    CheminClasseursAudits = ActiveWorkbook.Path & "\Fichiers-à-traiter\"
    'Selectionner des fichiers Excel uniquement
    ClasseurAudit = Dir("*.xlsx")
    'Compteur de colonne
    NumeroColonne = 2
    'Traitement des classeurs

    For Each ClasseurAudit In CheminClasseursAudits

        'Insertion du centre
        ClasseurBilan.Name = ClasseurAudits.Worksheets(1).Range("NumeroColonne,1")
        ClasseurBilan.Worksheets(1).Range("D3") = ClasseurAudits.Worksheets(1).Range("NumeroColonne,2")
        'Insertion de la date
        ClasseurBilan.Worksheets(1).Range("D4") = ClasseurAudits.Worksheets(1).Range("NumeroColonne,3")
        'Insertion des noms
        ClasseurBilan.Worksheets(1).Range("B3") = ClasseurAudits.Worksheets(1).Range("NumeroColonne,4")
        ClasseurBilan.Worksheets(1).Range("B4") = ClasseurAudits.Worksheets(1).Range("NumeroColonne,5")
        'Incrementation du compteur de colonne

        ClasseurAudits.Worksheets("Bilan").Range("C13:C33").Copy
        ClasseurAudits.Worksheets(1).Range("NumeroColonne,7").Select
        ClasseurAudits.Worksheets("Bilan").Range("C13:C33").Paste

        NumeroColonne = NumeroColonne + 1

Hoanam,

Si ton pb est toujours d'actualité :

Je te propose de faire ta boucle sur les objets files de FileSystemObject (tu dois référencer "Microsoft Scripting Runtime") :

Le code se présente alors comme :

Dim oWB As Excel.Workbook

Dim oFS As New Scripting.FIleSystemObject

Dim oFolder As Scripting.Folder

Dim oFile As Scripting.File

Dim CheminClasseursAudits As String, ClasseurAudit As Workbook, NumeroColonne As Integer

'Emplacement des fichiers d'audits

CheminClasseursAudits = ActiveWorkbook.Path

'Selectionner des fichiers Excel uniquement

'ClasseurAudit = Dir("*.xlsx")

'Compteur de colonne

NumeroColonne = 2

'Traitement des classeurs

Set oFolder = oFS.GetFolder(CheminClasseursAudits)

'For Each ClasseurAudit In CheminClasseursAudits

For Each oFile In oFolder

Set ClasseurAudit = Application.Workbooks.Open(oFile.Name)

'....

Next

Je n'ai pas regardé le contenu de la boucle plus avant. Mais "=ClasseurAudits.Worksheets(1).Range("NumeroColonne,1")" ne semble pas très orthodoxe.

Relance-moi si besoin.

Oh je l'avais oublié celui-là !

Merci beaucoup pour ton intérêt mais j'ai réglé le problème. Je vais bloquer le sujet ^^

Merci et à bientôt

Oh je l'avais oublié celui-là !

Merci beaucoup pour ton intérêt mais j'ai réglé le problème. Je vais bloquer le sujet ^^

Merci et à bientôt

Bonsoir haonam,

pouvez-vous partager avec nous la solution qui m'interesse personellement ?

Bonjour,

Eh bien, 2 ans après j'ai retrouvé le code !

Je me rappelle qu'à l'époque, je n'avais pas réussi à faire un copier/coller.

J'avais opté pour une autre solution : donner à une cellule du classeur d'arrivée la valeur contenue dans la cellule du classeur de départ, puis on passe à la cellule suivante puis on passe au classeur suivant.

Je joins le résultat.

A bientôt

'Partie 3 : Synthese des fichiers sources vers le fichier bilan
    Dim CheminClasseurAudit As String, NomClasseurAudit As String
    Dim ClasseurAudit As Workbook, NumeroColonne As Integer
    Dim NumeroLigneBilan As Integer, NumeroLigneAudit As Integer
    '\Fichiers-à-traiter\ est le dossier des classeurs a traiter
    'Emplacement des fichiers d'audits
    CheminClasseurAudit = ThisWorkbook.Path & "\Fichiers-à-traiter\"
    NomClasseurAudit = Dir(CheminClasseurAudit & "*.xls")
    'Numéro initial de la 1ère colonne
    NumeroColonne = 2

    'Traitement des classeurs

    Do While NomClasseurAudit <> ""
        'Ouvrir le classeur audit
        Set ClasseurAudit = Workbooks.Open(CheminClasseurAudit & NomClasseurAudit)
        'Insertion nom du classeur
        ClasseurBilan.Sheets(1).Cells(1, NumeroColonne) = ClasseurAudit.Name
        'Insertion nom du centre
        ClasseurBilan.Sheets(1).Cells(2, NumeroColonne) = ClasseurAudit.Sheets(1).Range("D3")
        'Insertion de la date
        ClasseurBilan.Sheets(1).Cells(3, NumeroColonne).NumberFormat = "m/d/yyyy"
        ClasseurBilan.Sheets(1).Cells(3, NumeroColonne) = ClasseurAudit.Sheets(1).Range("D4")
        'Insertion des deux noms
        ClasseurBilan.Sheets(1).Cells(4, NumeroColonne) = ClasseurAudit.Sheets(1).Range("B3")
        ClasseurBilan.Sheets(1).Cells(5, NumeroColonne) = ClasseurAudit.Sheets(1).Range("B4")

        'Initialisiation de la premiere cellule a extraire
        NumeroLigneBilan = 7
        NumeroLigneAudit = 13

        'Synthese des resultats compris entre la première cellule des resultats et celle contenant le mot "Moyenne"
        While ClasseurAudit.Sheets("Bilan").Cells(NumeroLigneAudit, 2) <> "Moyenne"
            'Extraction de la donnee concernee
            ClasseurBilan.Sheets(1).Cells(NumeroLigneBilan, NumeroColonne) = _
                ClasseurAudit.Sheets("Bilan").Cells(NumeroLigneAudit, 3)

            'Extraction des titres systematique au cas ou les classeurs n'ont pas tous les memes titres
            ClasseurBilan.Sheets(1).Cells(NumeroLigneBilan, 1) = _
                ClasseurAudit.Sheets("Bilan").Cells(NumeroLigneAudit, 2)

            'Donnee suivante
            NumeroLigneBilan = NumeroLigneBilan + 1
            NumeroLigneAudit = NumeroLigneAudit + 1

        Wend

        'Fermer le classeur d'audit ouvert
        ClasseurAudit.Close SaveChanges:=False

        'Colonne suivante
        NumeroColonne = NumeroColonne + 1
        'Classeur suivant
        NomClasseurAudit = Dir

    Loop

Bonjour,

Eh bien, 2 ans après j'ai retrouvé le code !

Je me rappelle qu'à l'époque, je n'avais pas réussi à faire un copier/coller.

J'avais opté pour une autre solution : donner à une cellule du classeur d'arrivée la valeur contenue dans la cellule du classeur de départ, puis on passe à la cellule suivante puis on passe au classeur suivant.

Je joins le résultat.

A bientôt

'Partie 3 : Synthese des fichiers sources vers le fichier bilan
    Dim CheminClasseurAudit As String, NomClasseurAudit As String
    Dim ClasseurAudit As Workbook, NumeroColonne As Integer
    Dim NumeroLigneBilan As Integer, NumeroLigneAudit As Integer
    '\Fichiers-à-traiter\ est le dossier des classeurs a traiter
    'Emplacement des fichiers d'audits
    CheminClasseurAudit = ThisWorkbook.Path & "\Fichiers-à-traiter\"
    NomClasseurAudit = Dir(CheminClasseurAudit & "*.xls")
    'Numéro initial de la 1ère colonne
    NumeroColonne = 2

    'Traitement des classeurs

    Do While NomClasseurAudit <> ""
        'Ouvrir le classeur audit
        Set ClasseurAudit = Workbooks.Open(CheminClasseurAudit & NomClasseurAudit)
        'Insertion nom du classeur
        ClasseurBilan.Sheets(1).Cells(1, NumeroColonne) = ClasseurAudit.Name
        'Insertion nom du centre
        ClasseurBilan.Sheets(1).Cells(2, NumeroColonne) = ClasseurAudit.Sheets(1).Range("D3")
        'Insertion de la date
        ClasseurBilan.Sheets(1).Cells(3, NumeroColonne).NumberFormat = "m/d/yyyy"
        ClasseurBilan.Sheets(1).Cells(3, NumeroColonne) = ClasseurAudit.Sheets(1).Range("D4")
        'Insertion des deux noms
        ClasseurBilan.Sheets(1).Cells(4, NumeroColonne) = ClasseurAudit.Sheets(1).Range("B3")
        ClasseurBilan.Sheets(1).Cells(5, NumeroColonne) = ClasseurAudit.Sheets(1).Range("B4")

        'Initialisiation de la premiere cellule a extraire
        NumeroLigneBilan = 7
        NumeroLigneAudit = 13

        'Synthese des resultats compris entre la première cellule des resultats et celle contenant le mot "Moyenne"
        While ClasseurAudit.Sheets("Bilan").Cells(NumeroLigneAudit, 2) <> "Moyenne"
            'Extraction de la donnee concernee
            ClasseurBilan.Sheets(1).Cells(NumeroLigneBilan, NumeroColonne) = _
                ClasseurAudit.Sheets("Bilan").Cells(NumeroLigneAudit, 3)

            'Extraction des titres systematique au cas ou les classeurs n'ont pas tous les memes titres
            ClasseurBilan.Sheets(1).Cells(NumeroLigneBilan, 1) = _
                ClasseurAudit.Sheets("Bilan").Cells(NumeroLigneAudit, 2)

            'Donnee suivante
            NumeroLigneBilan = NumeroLigneBilan + 1
            NumeroLigneAudit = NumeroLigneAudit + 1

        Wend

        'Fermer le classeur d'audit ouvert
        ClasseurAudit.Close SaveChanges:=False

        'Colonne suivante
        NumeroColonne = NumeroColonne + 1
        'Classeur suivant
        NomClasseurAudit = Dir

    Loop

Merci infiniment

Je commencerais à adapater votre code et des autres sur internet et je vous reviens avec les résultats

Rechercher des sujets similaires à "extraction donnees fichier"