recuperer les données de plusieurs fichiers

[okuteur]

Bonjour,

j'aurais aimé un coup de main pour adapter le code que j'ai trouvé sur le forum a mon problème

je souhaite copier le résultat de plusieurs fichiers dans un seul et même fichier "total.xsl" pour l'exemple.
je ne connais pas le nom des autres fichiers mais ils sont tous construit sur le même concept, a savoir 2 onglets, seul la 2eme ligne du 2eme onglet doit être récupérer.

le code que j'essaie de modifier:

Option Explicit
Option Base 1

Sub ChercheFichiersFermesV02()
Dim Source As ADODB.Connection
Dim Rst As ADODB.Recordset
Dim Fichier As String, Direction As String, texte_SQL As String
Dim X As Integer, NbFichiers As Integer, Y As Integer, N As Integer
Dim Tableau() As String

Application.ScreenUpdating = False

Direction = Dir(ThisWorkbook.Path & "\*.xls")
Do While Len(Direction) > 0 'liste tous les classeurs du repertoire
NbFichiers = NbFichiers + 1
ReDim Preserve Tableau(1 To NbFichiers)
Tableau(NbFichiers) = Direction
Direction = Dir()
Loop

If NbFichiers > 0 Then
For X = 1 To NbFichiers 'boucles sur les classeurs

    ' pour ne pas prendre en compte le classeur contenant la macro (synthese)
    If Tableau(X) <> ThisWorkbook.Name Then
    
        Fichier = ActiveWorkbook.Path & "\" & Tableau(X)
        N = 0
        
        Set Source = New ADODB.Connection
        Source.Open "Provider = Microsoft.Jet.OLEDB.4.0;" & _
                        "data source=" & Fichier & ";" & _
                        "extended properties=""Excel 8.0;"""
                        
        texte_SQL = "SELECT Produit.NbProduit" & _
                            " FROM Produit"
                            
        Set Rst = New ADODB.Recordset
        Set Rst = Source.Execute(texte_SQL)
       
        Do While Not Rst.EOF 'boucle sur les données
        Cells(N + 5, 2) = Cells(N + 5, 2) + Rst.Fields(0).Value
        N = N + 1
        Rst.MoveNext
        Loop
       
        Rst.Close
        Source.Close
        
    End If
Next X
End If

Application.ScreenUpdating = True
End Sub

si l'auteur du code ou une autre âme charitable veut bien m'aider.

 

[matthieu33]

Re : recuperer les données de plusieurs fichiers

Bonsoir okuteur,

Voici une solution.
J'espère que cela te conviendra.

 

[okuteur]

Re : recuperer les données de plusieurs fichiers

yeah matthieu33

c'est exactement ce que je voulais faire 🙂
en plus tu as laissé des commentaires je vais pouvoir comprendre

c'est une idée ou le code est plus simple que ce que j'avais collé ?

la réponse était vite fait en tout cas merci encore

 

[flosauveur69]

Re : recuperer les données de plusieurs fichiers

Bonjour,

petite question suite à cette macro:

je voudrais faire la même chose que dans le fichier total.xls sauf qu'au lieu d'avoir la ligne 2 je voudrais la plage de cellule A13 B30.

merci

 

[Guest]

Re : recuperer les données de plusieurs fichiers

Bonjour,

remplacer la ligne:

Worksheets(2).Rows("2:2").Copy Destination:=Workbooks(strWB).Worksheets("Feuil1").Range("A" & lgDerLig)

Par:

Worksheets(2).Range("A13:B30").Copy Destination:=Workbooks(strWB).Worksheets("Feuil1").Range("A" & lgDerLig)

devrait le faire.

A+

 

[flosauveur69]

Re : recuperer les données de plusieurs fichiers

Merci!! Parfait et 2ème question: Comment faire si les fichiers "esclaves" se trouvent dans le même répertoire que le fichier total.xls mais tous sont dans des sous répertoire.

Merci

 

[Guest]

Re : recuperer les données de plusieurs fichiers

Re,

 Comment faire si les fichiers "esclaves"[B] se trouvent dans le même répertoire que le fichier total.xls[/B] mais tous sont dans des sous répertoire.

Ils sont dans des sous répertoires ou non?

Si c'est dans un sous répertoire, c'est pas sorcier quand même!

strFile = Dir(ThisWorkbook.Path & "\SousRepertoire\*.xls")

En essayant de comprendre, on comprend.

A+

 

[flosauveur69]

Re : recuperer les données de plusieurs fichiers

re,

désolé mais je comprend les différentes lignes de codespar contre comme je suis novice en VBA, je ne sais pas rajouter des choses.
Par contre en essayant de comprendre, j'ai vu qu'il fallait changer la ligne lgDerLig = lgDerLig + 1 en lgDerLig = lgDerLig + 17 selon le nombre de ligne voulue sinon du coup cela copie les données les unes sur les autres.

Autres points, comme j'ai beaucoup de fichiers excel fils dont le nombre grandit continuellement, j'aimerais (si c'est réalisable), que la macro m'ouvre et me ferme que les fichiers dans lesquels la plage de cellule n'a pas été récupérer.

Je te remercie vivement pour ton aide

 

[Guest]

Re : recuperer les données de plusieurs fichiers

Re,

Ce serait bien que tu ouvres ton propre fil sur le sujet, car là on s'éloigne de la demande originale de cette discussion.

A+

 

[flosauveur69]

Re : recuperer les données de plusieurs fichiers

OK, voici le nouveau sujet: https://www.excel-downloads.com/threads/recuperer-seulement-les-nouvelles-donnees.149389/

Cdlmt

 

[flosauveur69]

Re : recuperer les données de plusieurs fichiers

Je reviens sur ce post car j'aimerais désormais récupérer les plages de cellules des classeur contenus dans les sous-répertoires du dossier D:\Documents and Settings\fl\Bureau\testlist\test.

J'ai donc modifié la macro comme ci-dessous mais elle ne fonctionne pas et j'ai essayé 2-3 trucs mais rien n'a marché. Elle s’exécute et m'affiche le boite de dialogue finale sans avoir récupérer les plages de cellules.

Private Sub cmdRecupere_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 ci dessous et sous repertoire
strFile = Dir("D:\Documents and Settings\fl\Bureau\testlist\test" & "\SousRepertoire\*.xls")

' Boucle du 1er au dernier classeur dans le répertoire et sous repertoire
Do While strFile <> ""
' Si le classeur n'est pas "Total.xls"
If strFile <> strWB Then
' Ouvrir le fichier
Workbooks.Open ThisWorkbook.Path & "\" & strFile

' Sélectionner le 1er onglet
ActiveWorkbook.Worksheets(1).Activate
' Copier la sélection dans le classeur
Worksheets(1).Range("A13:B28").Copy Destination:=Workbooks(strWB).Worksheets("Feuil1").Range("A" & lgDerLig)

lgDerLig = lgDerLig + 15

' 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

 

[flosauveur69]

Re : recuperer les données de plusieurs fichiers

Bonjour,

j'ai un souci avec le bouton récupération data, je n'arrive pas à le modifier ou le déplacer. J'aimerais le mettre à la place du bouton dans l'onglet explications.

Si quelqu'un peut m'aider.

Je met le fichier en pièces jointes.

Merci

 

[Guest]

Re : recuperer les données de plusieurs fichiers

bonjour,

Ouvre ton propre fil de discussion.

A+

 

[lefou63]

Re : recuperer les données de plusieurs fichiers

Hello !

Je ne sais pas si je dois ouvrir mon propre fil, j'ai essayé le syteme de mathieu33. Cela fonctionne bien. C'est niquel.

J'aurais deux petits trucs a demandé : Peut on reproduire la mise en forme (la taille des colonnes...) du morceaux dupliquer et peut on faire la meme manip dans l'autre sens, c'est a dire avoir un groupement de données et les separés dans differents fichiers xls ?

Et aussi peut on faire pour que le document total soit actualiser automatiquement a l'ouverture sans refaire la recuperation ? (mais bon la faut que j'ouvre un nouveau fil de discussion je suppose ?! 😀)

Merci, bonne soirée.

 

[flosauveur69]

Re : recuperer les données de plusieurs fichiers

Bonjour,

je reviens sur cette macro, car j'aimerais une piste d'amélioration:

Pour aller me copier-coller la plage de cellule voulue, cette macro, m'ouvre puis me ferme chacun des classeur xls. J'aimerais, si possible, que la macro me récupère et me colle cette plage de cellule sans ouvrir puis fermer les classeurs dans le but de gagner du temps.

merci d'avance