Macro excel récupération de données

Question

Bonjour, 
Voilà mon problème.
J'ai 3000 fichiers dans un répertoire.
Ces fichiers sont tous de format identiques.
Ils contiennent seulement des N° dans 9 cellules (1 Nombre à 3 chiffres par cellule) ( ex: cellule A1= 100, A2=101 A3 =205 etc juqu'a A9=905).
Puis sur une autre ligne plus bas, autre chose avec des N° différents.
Je voudrais récupérer les données de chaque fichier.
Puis les coller dans une feuille.
Chaque ligne A1:A9 de chaque feuille de mes 3000 fichiers dans une feuille1, puis chaque ligne  C1:C9 de chaque feuille de mes 300 fichiers dans une autre feuille etc ...
Pour me retrouver au final avec dans chaque feuille, 26000 lignes archivées.
L'idéal serait d'avoir une macro qui n'ouvre pas les 3000 fichiers puisque chacun fait 3M0.
Pour moi qui ne maitrise pas le VBA, c'est une montagne ce problème.
Si vous avez une solution cela m'aiderai énormément.Mais est ce possible?
Merci d'avance.
Laurent

cs_MPi · Answer

De quel format sont ces 3000 fichiers ?
txt, csv, xls,...&

Tu n'auras pas vraiment le choix que de les ouvrir si tu veux pouvoir les lire...

MPi²
Pour ceux qui programment sous Office, n'oubliez pas qu'il existe un forum dédié à ces applications VBA....... ICI

laurent56380 · Answer

Bonjour et merci de vous pencher sur mon problème.
Mes fichiers sont tous des fichiers xls.
Au pire je veux bien ouvrir les fichiers par paquet de 80, ( ce que mon Pc accèpte)mais après au lieu de faire des copier collé à la main, je souhaiterai avoir une macro pour simplifier la chose.
Surtout que toutes les plages que je récupèrent sont aux mêmes endroits.
Laurent

cs_MPi · Answer

Il ne s'agit pas d'ouvrir une série de fichiers en même temps. 
Mais plutôt une simple boucle pour ouvrir chaque fichier du répertoire (Workbooks.Open), un à un, faire les copies qu'il faut et les refermer au fur et à mesure.

Fait une recherche sur la fonction DIR dans ton aide et sur ce site. Tu devrais trouver ton bonheur. 

Une fois la boucle de lecture complétée (avec DIR), il te restera à copier les cellules A1:A9 et C1:C9 dans le fichier en cours en vérifiant la première ligne vide où coller ces données.
PremierLigneVide = Cells(Rows.Count, "A").End(xlUp).Row + 1

Regarde aussi les commandes Copy et PasteSpecial si tu ne les connais pas...

MPi²
Pour ceux qui programment sous Office, n'oubliez pas qu'il existe un forum dédié à ces applications VBA....... ICI

laurent56380 · Answer

Merci du coup de main,
J'ai trouvé ce qu'il me faut.
Cette macro que j'ai adapté, va chercher la plage que je souhaite sans ouvrir aucun fichier.
Elle colle les plages dans la feuille encourt à partir de la 4ème ligne et les transpose.
Puis elle recopie la suite toutes les 9 lignes.
Mes plages font toujour 9 cellules horizontales et il me les fallait à la suite à la verticale.
Génial.
Que de temps gagné et pas de risque d'erreurs.
Merci
Laurent

Sub rapatriement()
Dim Fich As String, Ligne As Long
Const Chemin = "D:\ABC\essai"
Ligne = 4
Fich = Dir(Chemin & "\*.xl*")
Do While Fich <> ""
Workbooks.Open Filename:=Chemin & Fich
Sheets("Feuil1").Select
Range("A1:J2").Copy


ThisWorkbook.Sheets("Feuil1").Cells(Ligne, 1).PasteSpecial _
xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=True


Ligne = Ligne + 9
Workbooks(Fich).Close False
Fich = Dir
Loop
End Sub

cs_MPi · Answer

Content de voir que tu as su te débrouiller par toi-même...

MPi²
Pour ceux qui programment sous Office, n'oubliez pas qu'il existe un forum dédié à ces applications VBA....... ICI

laurent56380 · Answer

Oui mais un petit problème quand même.
La macro marche bien, mais comme mes fichiers se nommes 01(01.10.1999).xls à 3000(20.01.2008).xls la macro ne me range pas tout dans l'ordre.
A partir du fichier 10 elle prend le fichier 100.
Quoi faire, dois-je renomer tous mes fichiers en les faisant précéder d'un "A"?
Laurent

cs_MPi · Answer

Si c'est nécessaire de conserver un ordre d'ouverture selon le nom des fichiers, le plus simple serait de les renommer. Comme tu as 3000 fichiers, ça prendrait un numéro de 4 chiffres au début du nom des fichiers.

En te servant de la même boucle que tu as et qui utilise DIR, tu passes un premier coup et tu renommes la partie de gauche du fichier. Si le format est toujours comme tu l'indiques, ie des chiffres, une parenthèse ouvrante et le reste, tu peux utiliser Split sur cette parenthèse.

ex:
Dim Fich As String, Chemin As String
Dim Tablo() As String
    
Chemin = "C:"  'le vrai chemin
Fich = Dir("C:\*.xl*")
Do While Fich <> ""
    'sépare le nom du fichier en 2 parties Tablo(0) et Tablo(1)
    Tablo = Split(Fich, "(") 
    'renomme le fichier
    Name Chemin & Fich As _
              Chemin & Format(Tablo(0), "0000") & "(" & Tablo(1)       
    Fich = Dir
Loop

Donc, si le nom du fichier est 01(01.10.1999).xls
il se nommera dorénavant 0001(01.10.1999).xls

Fait un test pour commencer en utilisant le pas-à-pas (F8)
Note que ma variable chemin est différente de la tienne. C'est vraiment le chemin et pas de *.xl*

Ensuite, tu peux reprendre ton autre code.
Et si l'ordre n'est toujours pas respecté, il faudra que tu utilises une listbox, un tableau, ou autre... pour stocker les noms et les trier. Ensuite, tu boucles cette liste pour lire les fichiers.

MPi²
Pour ceux qui programment sous Office, n'oubliez pas qu'il existe un forum dédié à ces applications VBA....... ICI

laurent56380 · Answer

Oui le but de la macro est bien de ranger les données par date, car je les analyses ensuite, donc si une journée passe devant une autre, tout est faux.

J'ai essayé en renomant les fichiers mais c'est la même chose.
J'ai mis 3 zéro davant le nom
arrivé au fichier 10, il ouvre ensuite le 100 au lieu du 11.
Et je ne sais pas comment faire pour la liste box ou le tableau.
Je ne connais pas grand chose en VBA.
Et dire que j'y étais presque.
Laurent

cs_MPi · Answer

En conservant le même code, tu ajoutes une ligne pour charger une listbox
Chemin = "C:"  'le vrai chemin
Fich = Dir("C:\*.xl*")
Do While Fich <> ""
    'sépare le nom du fichier en 2 parties Tablo(0) et Tablo(1)
    Tablo = Split(Fich, "(") 
    'renomme le fichier
    Name Chemin & Fich As _
              Chemin & Format(Tablo(0), "0000") & "(" & Tablo(1)       
    Listbox1.AddItem Chemin & Format(Tablo(0), "0000") & "(" & Tablo(1)   
    Fich = Dir
Loop

Une fois cette boucle terminée, il faudra la trier si tu es sous Excel. Les listbox n'ont pas la propriété Sorted comme sous VB6... dommage.

Pour le tri, tu devrais trouver sur le site... Là je dois aller souper. 
Si tu ne trouves j'y reviendrai...

MPi²
Pour ceux qui programment sous Office, n'oubliez pas qu'il existe un forum dédié à ces applications VBA....... ICI

laurent56380 · Answer

Je suis désolé, je ne sais même pas ou copier tout ce code.
Je suis complètement dépassé.
Laurent

laurent56380 · Answer

j'ai essayé de faire au mieux, mais cela bloque sur la ligne 
Listbox1.AddItem Chemin & Format(Tablo(0), "0000") & "(" & Tablo(1) 
tout passe en jaune
et il me répond erreur d'exécution 424
Pourtant lorsque je vais dans le répertoire des fichiers, il change bien le nom du 1er fichier.
le 01(01.10.1999).xls  devient  le 0001(01.10.1999).xls

Je ne comprends plus.
Laurent

laurent56380 · Answer

voici le code si cela peu vous aider à me dépanner.

Sub rapatriement()
Dim Fich As String, Chemin As String
Dim Tablo() As String
Chemin = "D:\ABC\Laurent\Archives complètes"
Fich = Dir("D:\ABC\Laurent\Archives complètes\*.xl*")


Ligne = 4


Do While Fich <> ""
'sépare le nom du fichier en 2 parties Tablo(0) et Tablo(1)
    Tablo = Split(Fich, "(")
    'renomme le fichier
    Name Chemin & Fich As _
              Chemin & Format(Tablo(0), "0000") & "(" & Tablo(1)
    Listbox1.AddItem Chemin & Format(Tablo(0), "0000") & "(" & Tablo(1)
    Fich = Dir
Loop
Workbooks.Open Filename:=Chemin & Fich
Sheets("Feuil1").Select
Range("A1:J2").Copy


ThisWorkbook.Sheets("Feuil1").Cells(Ligne, 1).PasteSpecial _
xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=True


Ligne = Ligne + 9
Workbooks(Fich).Close False
Fich = Dir


End Sub

cs_MPi · Answer

Sans vraiment pouvoir vraiment tester, ça devrait ressembler à ça...

Sub Rapatriement()
    Dim Fich As String, Chemin As String
    Dim TabloTmp() As String, TabloFichiers() As String
    Dim I As Integer, J As Integer, Idx As Integer
    
    Chemin = "D:\ABC\Laurent\Archives complètes"
    Fich = Dir("D:\ABC\Laurent\Archives complètes\*.xl*")
    
    Ligne = 4
    Idx = 0 'Index utilisé pour le tableau dynamique de fichier
    ReDim TabloFichiers(0) 'initialiser le tableau
    
    'Boucle pour renommer les fichiers
    'et charger un tableau avec les noms de ces fichiers
    Do While Fich <> ""
    'sépare le nom du fichier en 2 parties Tablo(0) et Tablo(1)
        TabloTmp = Split(Fich, "(")
        'renomme le fichier
        Name Chemin & Fich As _
             Chemin & Format(TabloTmp(0), "0000") & "(" & TabloTmp(1)
        'Charge le tableau de fichiers
        ReDim Preserve TabloFichiers(Idx)
        TabloFichiers(Idx) = _
            Format(TabloTmp(0), "0000") & "(" & TabloTmp(1)
        Idx = Idx + 1
        Fich = Dir
    Loop
    
    Trier TabloFichiers     'Appel de la procédure de tri pour le tableau de fichiers

    'Boucler le tableau trié des fichiers (plus besoin du DIR)
    For I = 0 To UBound(TabloFichiers)
        Workbooks.Open Chemin & TabloFichiers(I)
        Sheets("Feuil1").Select
        Range("A1:J2").Copy
        
        ThisWorkbook.Sheets("Feuil1").Cells(Ligne, 1).PasteSpecial _
                xlPasteValuesAndNumberFormats, Operation:= _
                xlNone, SkipBlanks:=False, Transpose:=True
        
        Ligne = Ligne + 9
        Workbooks(TabloFichiers(I)).Close False
    Next

End Sub

Sub Trier(Tablo)
    Dim I As Integer, J As Integer
    Dim strTemp As String
    
    For I = 0 To UBound(Tablo)
        For J = I To UBound(Tablo)
            If Tablo(I) > Tablo(J) Then
                strTemp = Tablo(I)
                Tablo(I) = Tablo(J)
                Tablo(J) = strTemp
            End If
        Next
    Next
End Sub

MPi²
Pour ceux qui programment sous Office, n'oubliez pas qu'il existe un forum dédié à ces applications VBA....... ICI

laurent56380 · Answer

Un grand merci pour tout le temps que vous passez à m'aider.
J'ai essayé la macro.
Elle plante à cette ligne.
Name Chemin & Fich As _
             Chemin & Format(TabloTmp(0), "0000") & "(" & TabloTmp(1)
Mais elle renome bien tous les fichiers.
Laurent

cs_MPi · Answer

Peut-être est-ce parce que le fichier porte le même nom (?)

Essaie comme ceci
If Chemin & Fich <> Chemin & Format(TabloTmp(0), "0000") & "(" & TabloTmp(1) Then
Name Chemin & Fich As _
             Chemin & Format(TabloTmp(0), "0000") & "(" & TabloTmp(1)
End If

MPi²
Pour ceux qui programment sous Office, n'oubliez pas qu'il existe un forum dédié à ces applications VBA....... ICI

laurent56380 · Answer

Merci encore.
Je n'ai plus le temps nécessaire pour poursuivre cette nuit.
Je reprendrai cet après midi.
Merci encore 
Laurent

laurent56380 · Answer

J'ai essayé mais çà bloque toujours au même endroit. Là ou j'ai mis la ligne en rouge. Voici le code Sub Rapatriement() Dim Fich As String, Chemin As String Dim TabloTmp() As String, TabloFichiers() As String Dim I As Integer, J As Integer, Idx As Integer Chemin = "D:\ABC\Laurent\Archives complètes" Fich = Dir("D:\ABC\Laurent\Archives complètes\*.xl*") Ligne = 4 Idx = 0 'Index utilisé pour le tableau dynamique de fichier ReDim TabloFichiers(0) 'initialiser le tableau 'Boucle pour renommer les fichiers 'et charger un tableau avec les noms de ces fichiers Do While Fich <> "" 'sépare le nom du fichier en 2 parties Tablo(0) et Tablo(1) TabloTmp = Split(Fich, "(") 'renomme le fichier If Chemin & Fich <> Chemin & Format(TabloTmp(0), "0000") & "(" & TabloTmp(1) Then Name Chemin & Fich As _ Chemin & Format(TabloTmp(0), "0000") & "(" & TabloTmp(1) End If 'Charge le tableau de fichiers ReDim Preserve TabloFichiers(Idx) TabloFichiers(Idx) = _ Format(TabloTmp(0), "0000") & "(" & TabloTmp(1) Idx = Idx + 1 Fich = Dir Loop Trier TabloFichiers 'Appel de la procédure de tri pour le tableau de fichiers 'Boucler le tableau trié des fichiers (plus besoin du DIR) For I = 0 To UBound(TabloFichiers) Workbooks.Open Chemin & TabloFichiers(I) Sheets("Feuil1").Select Range("A1:J2").Copy ThisWorkbook.Sheets("Feuil1").Cells(Ligne, 1).PasteSpecial _ xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=True Ligne = Ligne + 9 Workbooks(TabloFichiers(I)).Close False Next End Sub Sub Trier(Tablo) Dim I As Integer, J As Integer Dim strTemp As String For I = 0 To UBound(Tablo) For J = I To UBound(Tablo) If Tablo(I) > Tablo(J) Then strTemp = Tablo(I) Tablo(I) = Tablo(J) Tablo(J) = strTemp End If Next Next End Sub

laurent56380 · Answer

Je viens de voir que le signe entre le mot Chemin et Fich, se transforme en "&" dans mon fichier excel.



Est ce la raison?

If Chemin & Fich <> Chemin & Format(TabloTmp(0), "0000") & "(" & TabloTmp(1) Then





Laurent

cs_MPi · Answer

As-tu un message d'erreur ?
si oui quel numéro et quelle description ?

MPi²
Pour ceux qui programment sous Office, n'oubliez pas qu'il existe un forum dédié à ces applications VBA....... ICI

laurent56380 · Answer

oui N°9 
L'indice n'appartient pas à la sélection

cs_MPi · Answer

Est-ce que tous les fichiers du répertoire ont le même format avec 1 ou plusieurs chiffres et une parenthèse ouvrante ?

MPi²
Pour ceux qui programment sous Office, n'oubliez pas qu'il existe un forum dédié à ces applications VBA....... ICI

cs_MPi · Answer

Comme je suis à peu près certain qu'un ou plusieurs fichiers n'ont pas le même format, mets ceci Do While Fich <> "" 'sépare le nom du fichier en 2 parties Tablo(0) et Tablo(1) If Instr(1, Fich, "(") > 0 then Tablo = Split(Fich, "(") 'renomme le fichier Name Chemin & Fich As _ Chemin & Format(Tablo(0), "0000") & "(" & Tablo(1) Listbox1.AddItem Chemin & Format(Tablo(0), "0000") & "(" & Tablo(1) Else strTemp = strTemp & Fich & vbcrlf End If Fich = Dir Loop et avant le End Sub If strTemp <> "" Then MsgBox "Ces fichiers ne sont pas conformes" & vbcrlf & strTemp End If MPi² Pour ceux qui programment sous Office, n'oubliez pas qu'il existe un forum dédié à ces applications VBA....... ICI

laurent56380 · Answer

oui exactement

Macro excel récupération de données

23 réponses

Votre réponse

Discussions similaires