Bonjour
Je dois récupérer les données présentes dans une centaine de fichiers Excel pour les regrouper ensuite dans un seul fichier Excel.
Je précise que les quelques 100 fichiers sources sont au même format :
- 1 seul onglet (même nom pour tous les fichiers)
- même 1ère ligne d'entête
- les données sont présentes de la ligne n°2 à la dernière ligne (le nombre de lignes varie selon les fichiers)
Le fichier global reprend les mêmes entêtes donc il s'agit "juste" de faire un copier-coller des lignes de données de chaque fichier source jusqu'au fichier de destination global.
J'ai trouvé ce début de macro sur ce forum :
Code:
Option Explicit
Sub test()
Dim Fso As Object, MonRepertoire As String
Dim f1 As Object, f2 As Object, wb As Workbook
Set Fso = CreateObject("Scripting.FileSystemObject")
MonRepertoire = "C:\TEST EXCEL\"
For Each f1 In Fso.GetFolder(MonRepertoire).SubFolders
For Each f2 In f1.Files
Set wb = Workbooks.Open(f2)
'tes instructions
wb.Close
Next f2
Next f1
End Sub
Re : Macro pour regrouper données de plusieurs fichiers dans un fichier global
Bonjour ,
Peut être comme ceci , aprés il faudra peut être mieux définir les colonnes à copier :
Code:
Option Explicit
Sub test()
Dim Fso As Object, MonRepertoire As String
Dim f1 As Object, f2 As Object, wb As Workbook
Dim LigneFin As Long, LigneCible As Long
Set Fso = CreateObject("Scripting.FileSystemObject")
MonRepertoire = "C:\TEST EXCEL\"
'Balayage des sous répertoires
For Each f1 In Fso.GetFolder(MonRepertoire).SubFolders
'Balayages des fichiers du sous répertoire
For Each f2 In f1.Files
'Ouverture du fichier en cours
Set wb = Workbooks.Open(f2)
LigneFin = wb.ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
LigneCible = ThisWorkbook.ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row + 1
wb.ActiveSheet.Range("A2:AZ" & LigneFin).Copy ThisWorkbook.ActiveSheet.Range("A" & LigneCible)
wb.Close
Next f2
Next f1
End Sub
Re : Macro pour regrouper données de plusieurs fichiers dans un fichier global
Bonjour camarchepas
Désolé de ne répondre que maintenant, mais comme je suis salarié "multi-tache", je suis réquisitionné de temps en temps
Je vais tester le code et faire un retour ici dès demain.
Merci beaucoup pour l'aide
Re : Macro pour regrouper données de plusieurs fichiers dans un fichier global
Bonjour camarchepas
Nickel : l'import de toutes les données s'est fait dès le 1er essai
Par contre, juste pour info :
Comme on m'a finalement dit que les fichiers se trouveraient à l'avenir directement dans le dossier "C:\TEST EXCEL\"
j'ai fait les modifs suivantes :
Code:
Sub Macro_import()
Dim Fso As Object, MonRepertoire As String
Dim f2 As Object, f As Object, fc As Object, wb As Workbook
Dim LigneFin As Long, LigneCible As Long
Set Fso = CreateObject("Scripting.FileSystemObject")
MonRepertoire = "C:\FICHIERS EXCEL\"
Set f = Fso.GetFolder(MonRepertoire)
Set fc = f.Files
For Each f2 In fc
'Ouverture du fichier en cours
Set wb = Workbooks.Open(f2)
LigneFin = wb.ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
LigneCible = ThisWorkbook.ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row + 1
wb.ActiveSheet.Range("A2:AZ" & LigneFin).Copy ThisWorkbook.ActiveSheet.Range("A" & LigneCible)
wb.Close
Next f2
End Sub
Re : Macro pour regrouper données de plusieurs fichiers dans un fichier global
Argh
On vient de m'apprendre qu'en fait, il faudrait à partir de maintenant pouvoir importer les données directement depuis des fichiers .bin récupérés depuis l'intranet
C'est toujours agréable quand on vous explique les besoins en plusieurs fois
"Pourquoi faire simple quand on peut faire compliqué"
Donc, à priori, les fichiers Excel dont j'ai regroupé les données au préalable, sont à la base des fichiers .bin, avec la virgule comme séparateur.
Ces fichiers étaient convertis manuellement en fichiers Excel.
Il faudrait donc que la macro copie les données directement depuis les fichiers .bin, les colle dans le fichier Excel Global, puis déplace les fichiers .bin du dossier où ils sont enregistrés dans un dossier de sauvegarde (ceci afin de ne pas reprendre en compte les anciens fichiers .bin à chaque lancement de la macro).
Les données récupérées à chaque fois dans les fichiers .bin doivent être collées à la suite des données déjà présentes dans le dossier Excel Global.
Je suis donc reparti de la macro existante, à laquelle j'ai "greffée" un bout de code récupéré :
Code:
Option Explicit
Sub Macro_Bin()
Dim Fso As Object, MonRepertoire As String
Dim f1 As Object, f2 As Object, f As Object, fc As Object, wb As Workbook
Dim LigneFin As Long, LigneCible As Long
Dim intFileNum%, bytTemp As Byte, intCellRow%
intFileNum = FreeFile
intCellRow = 0
Set Fso = CreateObject("Scripting.FileSystemObject")
MonRepertoire = "C:\\FICHIERS BIN\"
Set f = Fso.GetFolder(MonRepertoire)
Set fc = f.Files
For Each f2 In fc
'Ouverture du fichier en cours
Open f2 For Binary Access Read As intFileNum
Do While Not EOF(intFileNum)
intCellRow = intCellRow + 1
Get intFileNum, , bytTemp
Cells(intCellRow, 1) = bytTemp
Loop
Close intFileNum
Next f2
End Sub
Mais ça ne fait que remplir la colonne A de chiffres ?!
En fait, quand on ouvre les fichiers, ce sont des lignes de champs texte, séparés par des virgules qui s'affichent.
Donc est-ce que je ne dois pas ouvrir les fichiers comme des fichiers .txt plutôt que comme des fichiers binaires ?
Re : Macro pour regrouper données de plusieurs fichiers dans un fichier global
Re ,
Oui comme un fichier csv en fait :
Sans fichier , je ne peux garantir le format mais quelque chose de la sorte :
Code:
Sub Macro_import()
Dim Fso As Object, MonRepertoire As String
Dim f2 As Object, f As Object, fc As Object, wb As Workbook
Dim LigneFin As Long, LigneCible As Long
Set Fso = CreateObject("Scripting.FileSystemObject")
MonRepertoire = "C:\FICHIERS BIN\"
Set f = Fso.GetFolder(MonRepertoire)
Set fc = f.Files
For Each f2 In fc
'Ouverture du fichier en cours
Set wb = Workbooks.OpenText(MonRepertoire & f2, Origin:=xlWindows, _
StartRow:=1, DataType:=xlDelimited, Local:=True, Semicolon:=True)
LigneFin = wb.ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
LigneCible = ThisWorkbook.ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row + 1
wb.ActiveSheet.Range("A2:AZ" & LigneFin).Copy ThisWorkbook.ActiveSheet.Range("A" & LigneCible)
wb.Close
Next f2
End Sub
Re : Macro pour regrouper données de plusieurs fichiers dans un fichier global
Bonjour ,
il faut essayer ce code pour voir s'il remonte bien les infos , par contre j'ai calibré sur 9 colonnes comme sur l'exemple donnée.
si ok , il suffira ensuite de l'incorporer à la boucle .
Attention , a adapter le chemin et nom d'un fichier
Code:
Sub test()
Dim MyString, MyNumber
Dim Indexe As Long, LigneCible As Long
Open "C:\Appli_Excel\Test\Nouveau dossier\Test\Reprise-edition-manuelle.csv_2014-12-02_06-45-13_5383021.bin" For Input As #1 ' Ouvre le fichier en lecture.
Do While Not EOF(1) ' Effectue la boucle jusqu'à la fin du fichier.
Line Input #1, MyString ' Lit les données dans deux variables.
' Affiche les données dans la fenêtre Exécution.
Debug.Print MyString, MyNumber
Loop
Close #1 ' Ferme le fichier.
Indexe = 0
Do
MyNumber = Split(MyString, vbLf)(Indexe)
If Indexe > 0 Then
LigneCible = ThisWorkbook.ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row + 1
ThisWorkbook.ActiveSheet.Range("A" & LigneCible & ":I" & LigneCible) = Split(MyNumber, ",")
End If
Indexe = Indexe + 1
Loop Until MyNumber = ""
End Sub
Re : Macro pour regrouper données de plusieurs fichiers dans un fichier global
Bonjour camarchepas
L'import des données pour 1 seul fichier .bin marche nickel
Merci beaucoup.
Je modifie la macro pour boucler sur tous les fichiers .bin d'un dossier, et essayer de déplacer ensuite les fichiers .bin dans un autre dossier de sauvegarde.
Je ferai un retour ici.
Option Explicit
Sub Macro_import_bin()
Dim Fso As Object, MonRepertoire As String, RepertoireDest As String
Dim f2 As Object, f As Object, fc As Object, wb As Workbook
Dim LigneFin As Long, LigneCible As Long
Dim MyString, MyNumber
Dim Indexe As Long
Dim NomFichier As Variant
Set Fso = CreateObject("Scripting.FileSystemObject")
MonRepertoire = "C:\FICHIERS TEXTES\"
RepertoireDest = "C:\SAUVEGARDE FICHIERS TEXTE\"
Set f = Fso.GetFolder(MonRepertoire)
Set fc = f.Files
For Each f2 In fc
NomFichier = f2.Name
'Ouverture du fichier en cours
Open f2 For Input As #1 ' Ouvre le fichier en lecture.
f2.Charset = "UTF-8"
Do While Not EOF(1) ' Effectue la boucle jusqu'à la fin du fichier.
Line Input #1, MyString ' Lit les données dans deux variables.
' Affiche les données dans la fenêtre Exécution.
Debug.Print MyString, MyNumber
Loop
Close #1 ' Ferme le fichier.
FileCopy f2, RepertoireDest & NomFichier
Kill f2
Indexe = 0
Do
MyNumber = Split(MyString, vbLf)(Indexe)
If Indexe > 0 Then
LigneCible = ThisWorkbook.ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row + 1
ThisWorkbook.ActiveSheet.Range("A" & LigneCible & ":I" & LigneCible) = Split(MyNumber, ",")
End If
Indexe = Indexe + 1
Loop Until MyNumber = ""
Next f2
End Sub
PS : je ne trouve pas la balise [CODE VBA] pour afficher un code plus lisible. Est ce que cette balise est "réservée" ?