Extraction des données de plusieurs fichiers xls

Salut, et bienvenue

Et c'est quoi la question ?

Merci,

Peut on créer une macro pour automatiser ce que je souhaiterai faire, à savoir:

récupération automatique des données contenues dans des fichiers Excel (placés dans un dossier spécifique), et agencées de la façon suivante, un fichier Excel = une feuille dédiée (Feuil1...) dans un fichier Excel "maitre".

Désolé si ce n'est pas clair, dites le moi j'essayerai de détailler.

Merci!

Salut,

Nous ne réalisons pas de travail à la demande.
Ce site est un forum d'entraide entre développeurs.
Cela dit, sache que nous acceptons volontiers les novices.

Bonjour,

Je ne demandais pas à ce qu'on me le fasse, je demandais juste si c'était possible et dans ce cas là me donner des pistes pour que j'essaye de faire quelque chose.
Je vais essayer de commencer tout seul, je posterai ce que j'ai trouvé...
Merci!

Bon, sache que la réponse à la question "Est-ce possible ?" est toujours "Oui".
C'est ce que je réponds toujours à mes clients (je suis pro). Mais j'ajoute toujours "Mais ça peut être très compliqué, ce qui veut dire très cher !"  

Ton problème est donc possible. Et il me semble même que ça peut être fait facilement.

Est-ce qui te pose problème ? Parcourir les fichiers d'un répertoire (pas évident au premier abord pour un débutant - on peut t'aider) ? Copier une feuille d'un classeur à l'autre (très facile si tu daignes te servir de l'enregistreur de macro - on peut t'aider aussi) ?

A te lire.

Bonjour Seb,

Merci pour ta contribution.
Effectivement le plus dur pour l'instant c'est de copier le contenu de plusieurs fichiers excel présent dans un dossier, vu que je n'ai aucune base...
Je pense quand même pouvoir m'en sortir pour le reste avec l'enregistreur et un peu de logique.
Je regarde ça cet aprem et poste quelque chose.

Bon, l'enregistreur de macro ne va pas t'être d'un grand secours pour lister des fichiers dans un dossier. Alors je te le donne, avant que tu ne t'énerves après l'aide d'Excel... C'est plus du VBS que du VBA  

Dim FSO As New FileSystemObject
Dim f As File
 
For Each f In FSO.GetFolder("ton dossier")
    If LCase(f.Name) Like "*.xls" Then
        MsgBox "Il faut faire quelque chose du fichier """ & f.Path & """"
    End If
Next

Tips : Pour que FileSystemObject soit connu d'Excel, il faut ajouter Microsoft Scripting Runtime (%windir%\System32\scrrun.dll) à tes références.

Je viens de voir ton post, je m'y penche de suite.

Voilà l'idée un peu si c'est plus compréhensible.

Ovrir dossier X

 
Assigner un numéro de 1 à X en fonction du nombre de fichier

 
 
If fichier X

Then open fichier X; lbl 1;

	Sheets("Feuil1").Select; 

	Cells.Select; 

	Selection.Copy; 

      open fichier maitre; 

	sheets("Feuil(X)).select; 

	ActiveSheet.paste; 

	Sheets("Feuil(X+1)").select; 

Else lbl2; 

 
lbl2; If fichier (X+1); 

then open fichier (X+1); goto 1; 

Else stop

 
End

edit: oups pardon  

(Attention, si le modérateur s'aperçoit que tu prends des libertés avec le règlement, ça va barder. Utilise la balise [code] pour présenter ton code   )

Ça te parle un peu Zeb le "code"? après c'est du bricolage...

C'est marrant, ça. Je te file le code pour parcourir les fichiers avec une jolie boucle For et tu me sors une horreur de code, digne des pires années 1985 avec des labels et des Goto.   <-- j'aime pô les gotoux

Bon, on a quelques idées sur la copie, on a la boucle sur les fichiers. Propose-moi de quoi ouvrir un classeur et on aura presque tous les éléments.

hoo un peu d'indulgence  
C'est mes restes de souvenirs de mes années lycée où on s'amusait à faire des programmes sur les calculettes...

Je construis et te propose.

edit: j'avous que c'est quand même horriblement môche...  

Voilà ce que j'ai pu trouvé jusqu'à maintenant, si tu peux me dire ce que tu en penses, notamment au niveau du problème à l'endroit précisé.

Option Explicit

Sub test()

 
 
Dim Fso  As Object

Dim MonRepertoire As String, f As Object

Dim f1 As Object

Set Fso = CreateObject("Scripting.FileSystemObject")

MonRepertoire = "D:\QuestionnaireTP"

 
For Each f In Fso.GetFolder(MonRepertoire).Files

    Workbooks(f).Worksheets("feuil1").Copy        'problème à ce niveau

    Workbooks.Open ("maitre.xls")

    Sheets("Feuil1").Paste

    Worksheets("Feuil1").Name = Sheets("Feuil1").Cells("D4")

    Worksheets.Add

 
 
 
Next f

 
End Sub

Option Explicit

EXCELLENT !!!!!!!!!!!!!!!!!!
Rien que ça, ça donne envie de t'aider

Sub test()
Dim Fso  As Object
Dim MonRepertoire As String, f As Object

Euh, ne t'ai-je pas proposé d'ajouter Microsoft Scripting Runtime à tes références,
et de déclarer FSO comme un New FileSystemObject et f comme un File ??
Tu peux faire autrement, mais donne-moi l'impression que je sers à quelque chose : ça ne donne pas envie de t'aider  

Dim f1 As Object

euh... ???

Set Fso = CreateObject("Scripting.FileSystemObject" )
MonRepertoire = "D:\QuestionnaireTP"
 
For Each f In Fso.GetFolder(MonRepertoire).Files

Faut l'ouvrir, le classeur f, avant de l'utiliser !
Et où as-tu vérifier qu'il s'agissait d'un classeur Excel ?

Workbooks(f).Worksheets("feuil1" ).Copy        'problème à ce niveau

Ah, ça c'est bien. C'est comme cela qu'on ouvre un classeur
Mais je me demande s'il est bien judicieux de l'ouvrir autant de fois qu'il y a de fichiers.

Workbooks.Open ("maitre.xls" )

Oui mais de quel classeur ?

Sheets("Feuil1" ).Paste

Raté. Cells() attend des coordonnées; Pour D4, c'est (4,4).
Utilise Range() si tu préfères la notation alphanumérique

Worksheets("Feuil1" ).Name = Sheets("Feuil1" ).Cells("D4" )

Euh, n'aurait-il pas fallu le faire avant ?

Worksheets.Add
Next f

Le f est optionnel. Indispendable en 1985 quand on n'avait pas encore inventé l'indentation que tu respectes : ça c'est très bien !

End Sub

Bon, ben il faut tout récrire !  
(   )

Option Explicit
 
Sub test()
    ' // Ajoute Microsoft Scripting Runtime à tes références.
    Dim FSO         As Scriting.FileSystemObject
    Dim file_quesTP As Scriting.File
 
    ' // Quelques variables
    Dim wb_maitre     As Workbook
    Dim wb_quesTP     As Workbook
    Dim ws_maitre_der As Worksheet
 
    ' // On ouvre le classeur maître
    Set wb_maitre = Workbooks.Open("un_chemin\maitre.xls")
 
    ' // On cherche sa dernière feuille
		Set ws_maitre_der = wb_maitre.Worksheets(wb_maitre.Worksheets.Count)
 
    For Each file_quesTP In FSO.GetFolder("D:\QuestionnaireTP").Files
 
        ' // On vérifie a priori que le fichier est un classeur (XLS)
        If UCase(file_quesTP.Name) Like "*.XLS" Then
            ' // On ouvre le classeur quesTP en lecture seule
            Set wb_quesTP = Workbooks.Open(file_quesTP.Path, ReadOnly:=True)
 
            ' // On copie la première page du quesTP dans le classeur maître, tout à la fin
            wb_quesTP.Worksheets(1).Cells.Copy After:=ws_maitre_der
 
            ' // On cherche la dernière feuille du maître qui est la nouvelle feuille
		        Set ws_maitre_der = wb_maitre.Worksheets(wb_maitre.Worksheets.Count)
 
            ' // On donne un ptit nom à la nouvelle feuille
            ws_maitre_der.Name = wb_quesTP.Worksheets(1).Range("D4")
 
            ' // On ferme le classeur quesTP, sans rien enregistrer - euh, à quoi sert le readonly alors ???
            wb_quesTP.Close SaveChanges:=False
        End If
    Next
 
    ' // On enregistre et on ferme le classeur maître
    wb_maitre.Save
    wb_maitre.Close SaveChanges:=False ' // paraniac coding
End Sub

Et voilà  

(Il manque encore la gestion des erreurs si un classeur ne peut pas être ouvert, enregistré, etc.)

Bonjour Zeb!

Un grand merci pour ces précisions.

Très bon pédagogue qui donne envie de se plonger concrètement dans les macros...

Je vais avoir besoin de toi encore, je suis entrain de terminer une autre partie et j'aimerai que tu me dises ce que tu en penses mais surtout si il y a une meilleur écriture car je pense que c'est un peu brouillon même si ça marche.

Et voila le second code que j’intégrerai au premier.

Option Explicit

Sub test()

'

' Macro2 Macro

'

Dim R As String

Dim X As Integer

Dim y As Integer

Dim z As Integer

Dim p As Integer

Dim u As Integer

 
 
Dim Cellule(23) As Integer

 
p = 5

 
For u = 2 To Worksheets.Count

 
 
    Worksheets(u).Select

 
    R = Range("D4")

    Cellule(1) = Range("D13")

    Cellule(2) = Range("D14")

    Cellule(3) = Range("D15")

    Cellule(4) = Range("d16")

    Cellule(5) = Range("d20")

    Cellule(6) = Range("d21")

    Cellule(7) = Range("d22")

    Cellule(8) = Range("d26")

    Cellule(9) = Range("d27")

    Cellule(10) = Range("d28")

    Cellule(11) = Range("d29")

    Cellule(12) = Range("d37")

    Cellule(13) = Range("d38")

    Cellule(14) = Range("d39")

    Cellule(15) = Range("d43")

    Cellule(16) = Range("d44")

    Cellule(17) = Range("d45")

    Cellule(18) = Range("d53")

    Cellule(19) = Range("d54")

    Cellule(20) = Range("d55")

    Cellule(21) = Range("d59")

    Cellule(22) = Range("d60")

    Cellule(23) = Range("d61")

 
 
    Sheets(1).Select

 
    y = 3

 
 
 
 
        For X = 1 To 23

 
 
 
            z = Cellule(X)

            Worksheets(1).Cells(p, y).Value = z

 
            X = X + 1

            y = y + 1

 
        Next

 
    Worksheets(1).Cells(p, 2).Value = R

 
    p = p + 1

 
 
Next u

 
 
 
End

 
 
 
End Sub

J'ai testé et il marche, mais il y a un soucis.
Comme tu le vois, les données que je veux récupérer dans un questionnaire sont en colonne et espacées. Je veux les mettre en ligne et ra-coller. Il y a bien le copier/coller mais ce n'est pas les bonnes données ou mal copiées.

Une idée?

Merci  

Beurk. j'aime pô voir des Select dans une macro.
Au lieu d'écrire

' // Code moche
Worksheets(u).Select
 
R = Range("D4" )
Cellule(1) = Range("D13" )
Cellule(2) = Range("D14" )

écris :

' // Code efficace
R = Worksheets(u).Range("D4" )
Cellule(1) = Worksheets(u).Range("D13" )
Cellule(2) = Worksheets(u).Range("D14" )

C'est un peu plus lourd à écrire, c'est vrai. Mais tu peux aussi utiliser une variable que tu substitues aux objects que tu utilises de façon récurrente :

Dim ws_source As Worksheet
Dim ws_cible  As Worksheet
 
...
 
Dim ws_source = Worksheets(1)
Dim ws_cible  = Worksheets(u)

------------

y = 3
For X = 1 To 23
    z = Cellule(X)
		Worksheets(1).Cells(p, y).Value = z
 
    X = X + 1
    y = y + 1
Next

Rhoolala, mais quelle horreur !!!!!!
Interdiction ABSOLUE de toucher à la variable d'itération dans une boucle For  
Quant à Y, m'enfin, réfléchis. Quelque soit x, y = x + 2.

For x = 1 To 23
		Worksheets(1).Cells(p, x + 2).Value = Cellule(x)
Next

T'as vu, j'ai viré z. Faut pas exagérer.

------------

Cellule(1) = Range("D13" )
Cellule(2) =  Range("D14" )
Cellule(3) =  Range("D15" )
Cellule(4) =  Range("d16" )
Cellule(5) =  Range("d20" )
Cellule(6) =  Range("d21" )
Cellule(7) =  Range("d22" )
Cellule(8) =  Range("d26" )
Cellule(9) =  Range("d27" )
Cellule(10) = Range("d28" )
Cellule(11) = Range("d29" )
Cellule(12) = Range("d37" )
Cellule(13) = Range("d38" )
Cellule(14) = Range("d39" )
Cellule(15) = Range("d43" )
Cellule(16) = Range("d44" )
Cellule(17) = Range("d45" )
Cellule(18) = Range("d53" )
Cellule(19) = Range("d54" )
Cellule(20) = Range("d55" )
Cellule(21) = Range("d59" )
Cellule(22) = Range("d60" )
Cellule(23) = Range("d61" )

M'ouhais ...   Alors d'abord, il manque la référence à la feuille, (puisqu'on vire le Select   ).
Et puis, dans ce cas, je verrais bien une notation numérique (Cells() plutôt que Range()).
Pour finir, ce n'est pas la cellule, mais la valeur de la cellule que tu mets dans ta variable.

Cellule(1) = CInt(Worksheets(u).Cells(13, 4).Value)
Cellule(2) = CInt(Worksheets(u).Cells(14, 4).Value)
Cellule(3) = CInt(Worksheets(u).Cells(15, 4).Value)
...

C'est un peu lourd. Je verrai bien une correspondance entre les lignes, plutôt :

1 -> 13
2 -> 14
3 -> 15
4 -> 16
5 -> 20

On peut le mettre dans un tableau comme tu as fait. Mais je préfère l'écriture avec un type Array() :

Dim racollage As Variant
racollage = Array(14, 15, 16, 20, 21, 22, 26, 27, 28, 29, 37, 38, 39, 43, 44, 45, 53, 54, 55, 59, 60, 61)

Faut juste faire gaffe au fait que le premier indice est 0.
Tout ceci donne cela :

Dim racollage As Variant
Dim ws_source As Worksheet
Dim ln_cible  As Range
Dim x         As Integer
 
racollage = Array(14, 15, 16, 20, 21, 22, 26, 27, 28, 29, 37, 38, 39, 43, 44, 45, 53, 54, 55, 59, 60, 61)
 
Set ln_cible = Worksheets(1).Rows(5)
 
For u = 2 To Worksheets.Count
    Set ws_source = Worksheets(u)
    ln_cible.Cells(2).Value = ws_source.Range("D4" )
    For x = 0 To UBound(racollage)
        ln_cible.Cells(x + 3).Value = ws_source.Cells(racollage(x), 4)
    Next
    Set ln_cible = ln_cible.Offset(1)
Next

------------------------------

Que penses-tu de " l'idée " ?  

Je pense que je ne comprends pas bien, mais elle doit surement être bonne.  

En supprimant le "X = X+1" la macro que j'ai écrite fonctionne parfaitement. Néanmoins je veux comprendre ton écriture.

Dim racollage As Variant        'ok

Dim ws_source As Worksheet             'ok

Dim ln_cible  As Range                      'ok

Dim x        As Integer                          'ok

racollage = Array(14, 15, 16, 20, 21, 22, 26, 27, 28, 29, 37, 38, 39, 43, 44, 45, 53, 54, 55, 59, 60, 61)          'ok

Set ln_cible = Worksheets(1).Lines(5)           'excel me dit qu'il y a une erreur, je vois pas où....

For u = 2 To Worksheets.Count     'ok

    Set ws_source = Worksheets(u)      'ok

    ln_cible.Cells(2).Value = ws_source.Range("D4" )        'ok

    For x = 0 To UBound(racollage)

        ln_cible.Cells(x + 3).Value = ws_source.Cells(racollage(x), 4)  'humm

    Next

    Set ln_cible = ln_cible.Offset(1)      'ok

Next

Edit : En relisant bien j'ai tout compris sauf l'erreur : set In_cible = WorkSheets(1).Lines(5)...

.....   .....

-----------------------------

Relis mieux mon code ....        

(Désolé, je ne peux pas toujours tester mes exemples)

Je m'y penche, je m'y penche...  

Quoi qu'il en soit, j'ai terminé ce que je voulais et la macro fonctionne parfaitement.

Option Explicit

Sub test()

    Dim FSO  As Object

    Dim file_quesTP As Object

    ' // Quelques variables

    Dim wb_maitre    As Workbook

    Dim wb_quesTP    As Workbook

    Dim ws_maitre_der As Worksheet

    Set FSO = CreateObject("Scripting.FileSystemObject")

    ' // On ouvre le classeur maître

    Set wb_maitre = Workbooks.Open("D:\QuestionnaireTP\rom\maitre.xlsx")

    ' // On cherche sa dernière feuille

    Set ws_maitre_der = wb_maitre.Worksheets(wb_maitre.Worksheets.Count)

 
    For Each file_quesTP In FSO.GetFolder("D:\QuestionnaireTP").Files

        ' // On vérifie a priori que le fichier est un classeur (XLS)

        If UCase(file_quesTP.Name) Like "*.XLSX" Then

            ' // On ouvre le classeur quesTP en lecture seule

            Set wb_quesTP = Workbooks.Open(file_quesTP.Path, ReadOnly:=True)

            ' // On copie la première page du quesTP dans le classeur maître, tout à la fin

            wb_quesTP.Worksheets(1).Copy After:=ws_maitre_der

            ' // On cherche la dernière feuille du maître qui est la nouvelle feuille

                Set ws_maitre_der = wb_maitre.Worksheets(wb_maitre.Worksheets.Count)

 
            ' // On donne un ptit nom à la nouvelle feuille

            ws_maitre_der.Name = wb_quesTP.Worksheets(1).Range("D4")

            ' // On ferme le classeur quesTP, sans rien enregistrer - euh, à quoi sert le readonly alors ???

            wb_quesTP.Close SaveChanges:=False

        End If

    Next

 
Dim R As String

Dim X As Integer

Dim y As Integer

Dim z As Integer

Dim p As Integer

Dim u As Integer

Dim Cellule(23) As Integer

p = 5

For u = 2 To Worksheets.Count

    Worksheets(u).Select

    R = Range("D4")

    Cellule(1) = Range("D13")

    Cellule(2) = Range("D14")

    Cellule(3) = Range("D15")

    Cellule(4) = Range("d16")

    Cellule(5) = Range("d20")

    Cellule(6) = Range("d21")

    Cellule(7) = Range("d22")

    Cellule(8) = Range("d26")

    Cellule(9) = Range("d27")

    Cellule(10) = Range("d28")

    Cellule(11) = Range("d29")

    Cellule(12) = Range("d37")

    Cellule(13) = Range("d38")

    Cellule(14) = Range("d39")

    Cellule(15) = Range("d43")

    Cellule(16) = Range("d44")

    Cellule(17) = Range("d45")

    Cellule(18) = Range("d53")

    Cellule(19) = Range("d54")

    Cellule(20) = Range("d55")

    Cellule(21) = Range("d59")

    Cellule(22) = Range("d60")

    Cellule(23) = Range("d61")

 
 
    Sheets(1).Select

    y = 3

 
 
 
 
        For X = 1 To 23

 
            z = Cellule(X)

            Worksheets(1).Cells(p, y).Value = z

 
            y = y + 1

 
        Next

    Worksheets(1).Cells(p, 2).Value = R

    p = p + 1

Next u

 
End

 
End Sub

Mais je vais essayer de le refaire correctement à partir de ton écriture pour mieux comprendre.

Merci vraiment pour tout, et surement à bientôt  

Meilleure réponse sélectionnée par romanohow.

A ça va les aider les gens qui vont lire ton sujet de savoir que la meilleure réponse à ta question c'est qu'il faut mettre le topic en résolu