Extraire plusieurs colonnes de plusieurs fichiers de même structure

Bonsoir,

Je suis nouveau sur ce forum.

Je souhaite extraire plusieurs colonnes de plusieurs fichiers de même structure (même colonnes), avec la possibilité de définir les numéros de colonnes à extraire. Est ce quelqu'un peut m'aider ?

Voir le fichier-joint pour plus de détails.

Merci de votre aide.

Bonjour Ansi19 et bienvenue sur ce forum,

à tester,

il faut activer la référence: Microsoft ActiveX Data Objects xx Library --> au menu vba, Outils, Référence

Sub Read_File()
Dim Repertoire As String, Fichier As String, Fich As String, NomFeuille As String
Dim Ligne As Long, f, colonne, col As Integer, addr As String
Dim fso As Object, sfofolder As Object, oFile As Object
Dim Cnn As Object, Rst As ADODB.Recordset
Ligne = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row + 1

Repertoire = ThisWorkbook.Path
NomFeuille = "Feuil1"          'à adapter

Set fso = CreateObject("Scripting.FileSystemObject")
Set sfofolder = fso.GetFolder(Repertoire)

 For Each oFile In sfofolder.Files
     '--- lire uniquement les fichiers qui ont un extention "xlsx"---
     If Right(Fich, 4) = "xlsx" Then  'à adapter

        Set Cnn = New ADODB.Connection
        '--- Connexion ---
        With Cnn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
        & oFile & ";Extended Properties=""Excel 12.0;HDR=NO;"""
        .Open
        End With

        colonne = Array(1, 2, 3, 4, 7, 12, 14)
        For i = LBound(colonne) To UBound(colonne)
            addr = Columns(colonne(i)).Address(0, 0)
            Set Rst = Cnn.Execute("SELECT * FROM [" & NomFeuille & "$" & addr & "]")
            Cells(Ligne, "A") = Fich
            col = Cells(Ligne, Columns.Count).End(xlToLeft).Column + 1
            Cells(Ligne, col).CopyFromRecordset Rst
            Rst.Close
            Set Rst = Nothing

        Next i
        Ligne = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row + 1
    End If
 Next oFile
Cnn.Close
Set Cnn = Nothing
End Sub

Merci i20100,

Je vais essayer et te donnerai un retour...

Ansi19.

Re-bonjour i20100,

Voici ce que j'ai fait:

* La macro est enregistrée dans le fichier "Fichier_attendu-1.xlsm", place dans un répertoire contenant le sous-répertoire de données ("données").

* J'ai trouvé plusieurs versions de library (de 2.0 à 2.8 et 6.1) dans

Microsoft ActiveX Data Objects xx Library --> au menu vba, Outils, Référence, j'ai uniquement activé le 6.1. Est-ce c'est ok ou dois-je aussi activer les autres ?

* Lorsque j'ai lancé la macro, j'ai eu le message suivant:

"Run-time error '91':

Object variable or With block variable not set"

En mode debug; l'instruction "Cnn.Close" est surlignée...

Merci de ton aide.

re,

j'ai fait quelque modofication,

à tester,

Sub Read_File()
    'Nécessite d'activer les références 
    'Microsoft ADO ext x.x for DLL and Security
    'Microsoft ActiveX Data Objects x.x Library

Dim Repertoire As String, Fichier As String, Fich As String, NomFeuille As String
Dim Ligne As Long, f, colonne, col As Integer, addr As String
Dim fso As Object, sfofolder As Object, oFile As Object
Dim Cnn As ADODB.Connection, Rst As ADODB.Recordset, oCat As ADOX.Catalog
Ligne = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row + 1

Repertoire = ThisWorkbook.Path
NomFeuille = "Feuil1"          'à adapter

Set fso = CreateObject("Scripting.FileSystemObject")
Set sfofolder = fso.GetFolder(Repertoire)

 For Each oFile In sfofolder.Files
     '--- lire uniquement les fichiers qui ont un extention "xlsx"---------------
     If Right(oFile, 4) = "xlsx" Then  'à adapter

        Set Cnn = New ADODB.Connection
                '--- Connexion ---
        With Cnn
            .Provider = "Microsoft.ACE.OLEDB.12.0"
            .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
            & oFile & ";Extended Properties=""Excel 12.0;HDR=NO;"""
            .Open
        End With

        Set oCat = New ADOX.Catalog
        oCat.ActiveConnection = Cnn

        For Each oSheet In oCat.Tables

     '--- lire uniquement les onglets nommé "Feuil1"------------------------------
            If oSheet.Name = NomFeuille & "$" Then

                v = Split(oFile, "\")
                Fich = v(UBound(v))

                colonne = Array(1, 2, 3, 4, 7, 12, 14)
                For i = LBound(colonne) To UBound(colonne)
                    addr = Columns(colonne(i)).Address(0, 0)
                    Set Rst = Cnn.Execute("SELECT * FROM [" & NomFeuille & "$" & addr & "]")
                    Cells(Ligne, "A") = Fich
                    col = Cells(Ligne, Columns.Count).End(xlToLeft).Column + 1
                    Cells(Ligne, col).CopyFromRecordset Rst
                    Rst.Close
                    Set Rst = Nothing

                Next i

                Ligne = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row + 1
            End If
     '-----------------------------------------------------------------------------
        Next oSheet
      End If
 Next oFile

 Set oCat = Nothing
 Set Cnn = Nothing
End Sub

Merci i20100.

Je n'ai pas vu d'erreurs en le faisant tourner. Par contre, comme je suis presque nul là-dedans, tu peux mettre des commentaires pour expliquer ce qu'on fait à chaque étape ?

Les fichiers de données sont à mettre dans le répertoire qui contient le fichier qui contient la macro. N'est ce pas ?

Sinon, dans les fichiers de données, je souhaite saisir le noms des onglets qui contiennent les données. Comment le faire ?

Peut-on faire pareil (saisir) avec les colonnes à extraire ?

Et les résultats vont se trouver dans quel fichier ?

re,

voici le fichier avec macro + commentaire ainsi que 2 fichiers de données qui m'ont servir à faire le test.

Bonjour,

Quand je l'exécute, j'ai le message suivant: "Run-time error'76'. Path not found", et en mode debug, il s'arrête à: "Set sfofolder = fso.GetFolder(Repertoire)"

Est-ce que j'ai raté ou oublié quelque chose ?

re,

as-tu enregistré les 3 fichiers sur ton pc ?

la variable Repertoire a la valeur du répertoire ou est enregistré le fichier "Ansi19-Fichier_attendu-1.xlsm"

Repertoire = ThisWorkbook.Path

Re,

Ca marche mieux en les mettant dans le même répertoir !

Maintenant, mes réels fichiers sources ont des extensions ".xlsb" et mes onglets sources ont un nom spécifique ("raw data").

NomFeuille = "Feuil1" ==> NomFeuille = "raw data" et

If Right(oFile, 4) = "xlsx" ==> If Right(oFile, 4) = "xlsb"

Ca ne fonctionne pas. D'où ça peut venir ?

re,

voici le nouveau code,

Sub Read_File()
Dim Repertoire As String, Fichier As String, Fich As String, NomFeuille As String, t As String, v
Dim Ligne As Long, f, colonne, col As Integer, addr As String, i As Integer
Dim fso As Object, sfofolder As Object, oFile As Object
Dim cnn As ADODB.Connection, rst As ADODB.Recordset, oCat As ADOX.Catalog, oSheet As Object

Ligne = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row + 1 'no. de la 1ere ligne vide +1

Repertoire = ThisWorkbook.Path                  'lire les fichiers de ce répertoire
NomFeuille = "'" & "raw data" & "$'"                          'lire toutes les feuilles ayant comme nom Feuil1"

Set fso = CreateObject("Scripting.FileSystemObject")
Set sfofolder = fso.GetFolder(Repertoire)

For Each oFile In sfofolder.Files              'pour chaque fichier dans le répertoire
     '--- lire uniquement les fichiers qui ont un extention "xlsx"---------------
    If Right(oFile, 4) = "xlsb" Then           'si l'extension du fichier est "xlsx"

        Set cnn = New ADODB.Connection          'créer un objet ADODB.Connection
    '--- établir la Connexion -------------------------------------------------------
        With cnn
            .Provider = "Microsoft.ACE.OLEDB.12.0"
            .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
            & oFile & ";Extended Properties=""Excel 12.0;HDR=NO;"""
            .Open
        End With

    '--- établir la Connexion -------------------------------------------------------
        Set oCat = New ADOX.Catalog              'créer un objet ADOX.Catalog
        oCat.ActiveConnection = cnn              'lier le catalog à la connexion
                                                 'le catalog contient tous les feuilles du classeur ofile + plage nommées et +

        For Each oSheet In oCat.Tables           'pour chaque object dans le catalog

     '--- lire uniquement les onglets nommé "raw data"------------------------------
            If oSheet.Name = NomFeuille Then  'si le nom de l'object oSheet est égale à la variable NomFeuille

                v = Split(oFile, "\")            'séparer la variable ofile en répertoire et nom du fichier
                Fich = v(UBound(v))              ' fich est = au nom du fichier et "." & et son extension

                colonne = Array(1, 2, 3, 4, 7, 12, 14)  'numéro des Colonnes à lire
                For i = LBound(colonne) To UBound(colonne) 'pour chaque colonne
                    addr = Columns(colonne(i)).Address(0, 0) 'adresse de colonne sans les $
                    Set rst = cnn.Execute("SELECT * FROM [" & oSheet.Name & "][" & addr & "]") ' chaine de la requete

                    Cells(Ligne, "A") = Fich   'inscription du nom de fichier en colonne A
                    col = Cells(Ligne, Columns.Count).End(xlToLeft).Column + 1  'no. la 1ere colonne vide +1
                    Cells(Ligne, col).CopyFromRecordset rst  'copier le résultat de la requête sur la feuille active
                    rst.Close  'fermer la requête
                    Set rst = Nothing  'vider l'espasce mémoire occuper par cette variable

                Next i

                Ligne = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row + 1 'no. de la 1ere ligne vide +1
            End If
     '-----------------------------------------------------------------------------
        Next oSheet

    End If
Next oFile

Set oCat = Nothing
Set cnn = Nothing
End Sub

Re,

Merci. Ca marche bien.

Pour une petite amélioration, peut-on écrire le résultat dans un nouveau fichier ?

peut-on écrire le résultat dans un nouveau fichier ?

oui, comment veux-tu procéder ?

veux-tu exécuter la macro à partir d'un nouveau classeur que tu auras créé

ou créer un nouveau classeur par vba via la macro Read_File

...plutôt créer un nouveau classeur par vba via ma macro Read_File.

Merci.

...plutôt créer un nouveau classeur par vba via ma macro Read_File.

Ajoute le code suivant en début de macro (juste après les déclarations Dim....)

Workbooks.Add

bonjour à vous

pourquoi ne pas récupérer TOUTES les colonnes ?

on peut ensuite masquer ce qui est inutile

cependant, en supposant qu'aucun être humain ne lise les données (des milliers de lignes ? ), c'est dans la méthode de traitement de synthèse des données qu'on filtrera les colonnes et non à l'imporatation.

votre avis ?

amitiés

Bonsoir,

merci i20100. C'est parfait.

Jmd,

Le problème c'est que mes fichiers sont trop grands (une vingtaine de fichiers de plus de 10 Mo chaque). Donc, prend beaucoup de ressources...Mais cela me fait penser à quelques chose: peut-on constituer une "base de donnés" sous Excel avec des données dans plusieurs fichiers différents ? Ou plus pratique, peut-on faire un tableau croisé à partir de données dans plusieurs fichiers différents ?

Merci Ansi19 pour ce retour, au plaisir!

si le problème est résolu, s.v.p. clôture le fil, par un clic sur le bouton (indiquer par la flèche verte)

resolu

Merci!

Bonsoir,

merci i20100. C'est parfait.

Jmd,

Le problème c'est que mes fichiers sont trop grands (une vingtaine de fichiers de plus de 10 Mo chaque). Donc, prend beaucoup de ressources...Mais cela me fait penser à quelques chose: peut-on constituer une "base de donnés" sous Excel avec des données dans plusieurs fichiers différents ? Ou plus pratique, peut-on faire un tableau croisé à partir de données dans plusieurs fichiers différents ?

re

alors, menu Données/obtenir/ de classeur (sifgnifiant "depuis un répertoire)

ceci peut lire des millions de lignes

et tu peux "nettoyer" les données assez facilement, grâce au GUI (menus et clics droits)

ensuite tu fais des TCD et GCD

essaye !

amitiés

Rechercher des sujets similaires à "extraire colonnes fichiers meme structure"