Résolu Extraction des données de plusieurs fichiers xls

[romanohow]

Bonjour à tous,

J'ai été chargé, pour mon stage, de créer un questionnaire pour des magasins et d'analyser les retours.
J'ai donc créé un questionnaire (Feuil1) sous excel que je vais envoyer aux magasins mais je risque d'avoir beaucoup de retour.
Aussi pour simplifier l'analyse, je pense qu'il existe une macro pour récupérer les "Feuil1" de tous les questionnaires présents dans un dossier et les ajouter les unes à la suite des autres dans un fichier excel à part où chaque questionnaire aura son onglet (Feuil1, Feuil2...) propre.
Le soucis bien évidement, c'est que je n'ai jamais fait de programmation, pour l'instant, mais je pense m'y mettre.
D'ici là j'aurai besoin d'aide.

En vous remerciant grandement par avance,

Romanohow

 

[zeb]

Salut, et bienvenue

Et c'est quoi la question ?

 

[romanohow]

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!

 

[zeb]

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.

 

[romanohow]

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!

 

[zeb]

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.

 

[romanohow]

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.

 

[zeb]

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.

 

[romanohow]

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

 

[zeb]

(Attention, si le modérateur s'aperçoit que tu prends des libertés avec le règlement, ça va barder. Utilise la balise

 pour présenter ton code ;) )

 

[romanohow]

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

 

[zeb]

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. :vomi: <-- 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.

 

[romanohow]

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... :/

 

[romanohow]

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

 

[zeb]

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à :sol:

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

 

[romanohow]

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.

 

[romanohow]

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

 

[zeb]

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 " ?

 

[romanohow]

[strike]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.[/strike]

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)...

 

[zeb]

..... .....

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

Relis mieux mon code ....

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