Macro pour regrouper données de plusieurs fichiers dans un fichier global

[Bilou74]

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 :

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

...mais je bloque sur les instructions

Pouvez-vous m'aider ?

 

[camarchepas]

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 :

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

 

[Bilou74]

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

 

[Bilou74]

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 :

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

Merci beaucoup camarchepas

 

[Bilou74]

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é :

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 ?

 

[camarchepas]

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 :

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

 

[Bilou74]

Re : Macro pour regrouper données de plusieurs fichiers dans un fichier global

Bonjour camarchepas,
merci encore de te pencher sur mon problème
J'ai testé le code, mais il me sort une erreur de compilation sur

.OpenText

L'erreur est "erreur de compilation fonction ou variable attendue"

J'ai regardé un peu et j'ai vu que certains rajoutaient Filename:= :

Set wb = Workbooks.OpenText(Filename:=MonRepertoire & f2, Origin:=xlWindows, _

Malheureusement, l'erreur reste identique après ce changement...

(Pour les fichiers, j'ai joint un ZIP avec le global.xls et un fichier .bin)

 

[camarchepas]

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

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

 

[Bilou74]

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.

 

[Bilou74]

Re : Macro pour regrouper données de plusieurs fichiers dans un fichier global

Cela fonctionne pour la boucle sur tous les fichiers .bin, l'import des données, puis le déplacement des fichiers ensuite.
Par contre, je rencontre un petit problème d'encodage des caractères.
Je me retrouve en effet avec des chaines de type "L'adhérent" au lieu de "L'adhérent"
J'ai vu une propriété .Charset = "UTF-8" mais elle ne passe pas dans la code : il me met "Propriété ou méthode non gérée par cet objet". (aussi bien sur Fso, f, fc, f2) :

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

 

[Bilou74]

Re : Macro pour regrouper données de plusieurs fichiers dans un fichier global

J'ai trouvé mon bonheur ici :
Conversion entre UTF-8 et ANSI (utf8 ansi vb) [Code inside] - VB/VBA/VBS - Programmation - FORUM HardWare.fr
Cela fonctionne très bien avec la fonction Decode_UTF8
Merci pour tout camarchepas