Regrouper plusieurs lignes de fichiers Excel différents

Le 10/05/2009 à 22:40

Existe il une solution à mon problème ?

J'ai plusieurs fichiers excel regroupant chacun une ou plusieurs lignes. Je souhaite regrouper d'une manière automatique toutes les lignes des différents fichiers dans un seul fichier.

Existe il un moyen ?

4classeur1v1.xlsm (137.11 Ko)
Le 10/05/2009 à 22:51

Bonjour. Bienvenue

Première précision. Tu parles de plusieurs fichiers xls ou de plusieurs feuilles d'un même fichier?

Seconde questions: S'il s"agit de plusieurs fichiers.xls, il faut plus de détails pour savoir si c'est faisable.

Sont-ils dans le même répertoire? Quelles feuilles sont concernées? et..

A te lire

Cordialement

Le 10/05/2009 à 23:02

Les fichiers sont dans le même répertoire.

Les lignes sont toutes sur la première feuille de chaque fichier et possèdent la même structure de colonne

Le 10/05/2009 à 23:15

Salut le forum

Grim, le répertoire des fichiers et les noms à récupérer.

Excel a besoin de concret pour travailler.

A te relire

Mytå

Le 15/05/2009 à 20:08

OK, et c'est normal.

Alors, voilà !

Dans un même répertoire sur réseau, j'ai des fichiers qui arrivent au fil de l'eau. ces fichiers décrivent des anomalies venant d'une application.

Les fichiers sont nommés de la manière suivante : CRA_EXP_TRANS_REJET_xxxxx (xxxxxx correspond à un chiffre qui s'incrémente = je ne sais pas par contre si c'est de manière chronologique).

Dans chaque fichier, la première ligne correspond à l'en tête et sur les autres lignes les informations Chaque fichiers peuvent comporter une ligne ou plusieurs. Chaque structure des fichiers est identique.

Mon besoin est de pouvoir de manière automatique de récupérer toutes les lignes d'information de chaque fichier et de les regrouper dans un seul fichier.

J'ai des fichiers d'exemple en espérant que je trouve la manière de les transmettre (dans le cas contraire, merci de me dire comment il faut faire)

Fichier du répertoire : https://www.excel-pratique.com/~files/doc2/HMUFsCRA_EXP_TRANS_REJET_6104235.xls

Fichier du répertoire :https://www.excel-pratique.com/~files/doc2/ktjd4CRA_EXP_TRANS_REJET_6130251.xls

Fichier résultat de mon besoin : https://www.excel-pratique.com/~files/doc2/c5oIKRecap.xls

Le 15/05/2009 à 21:55

Bonsoir

J'espère que cet exemple pourra t'aider.

La procédure boucle sur tous les classeurs d'un répertoire cible et extrait toutes les données de la Feuil1 pour les importer à la suite dans le feuille active.

L'exemple suppose que :

* Tous les onglets portent le même nom : 'Feuil1'.

* Les classeurs sont structurés comme une vraie base (pas de données éparpillées) et de manière identiques.

La procédure nécessite d'activer la référence Microsoft ActiveX Data Objects x.x Library

Sub tranfertClasseursFermes_VersFeuilleActive()
    'Nécessite d'activer la référence
        'Microsoft ActiveX Data Objects x.x Library
    Dim Cn As ADODB.Connection
    Dim Rst As ADODB.Recordset
    Dim j As Integer
    Dim i As Long
    Dim Fichier As String, Repertoire As String

    i = 1

    'Boucle sur les classeurs Excel du répertoire cible
    Repertoire = "C:\Documents and Settings\dossier"
    Fichier = Dir(Repertoire & "\*.xls")

    Do While Fichier <> ""
        'Connection au classeur Excel
        Set Cn = New ADODB.Connection
        Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
            "Data Source=" & Repertoire & "\" & Fichier & ";" & _
            "Extended Properties=""Excel 8.0;"""

        'requête pour extraire les données de la Feuil1
        Set Rst = New ADODB.Recordset
        Rst.Open "SELECT * FROM [Feuil1$]", Cn, adOpenStatic

        'Si la requete donne un resultat
        If Not Rst.EOF Then
            'S'il s'agit de la premiere ligne :
            'on boucle sur les en-tetes afin d'en extraire les noms
            If i = 1 Then
                For j = 0 To Rst.Fields.Count - 1
                    Cells(i, j + 1) = Rst.Fields(j).Name
                Next j

                i = 2
            End If

            'Copie le résultat de la requete dans la feuille active
            Range("A" & i).CopyFromRecordset Rst
            'Récupère le numero de la premiere ligne vide pour la
            'boucle suivante.
            i = Range("A1").End(xlDown).Row + 1
        End If

        'Fermeture recordset
        Rst.Close
        Set Rst = Nothing
        'Fermeture de la connection au classeur Excel
        Cn.Close
        Set Cn = Nothing
    Fichier = Dir
    Loop

End Sub

bon week end

michel

Le 26/05/2009 à 19:01

Merci, cela fonctionne mais j'ai un petit souci.

En effet, le nom de la feuille (une seule feuille par fichier) est égal au fichier de chaque fichier et chaque fichier est bien un fichier xls mais au format txt.

Que peut on faire pour remédier à cela ?

Le 27/05/2009 à 18:14

bonsoir

le nom de la feuille (une seule feuille par fichier) est égal au fichier de chaque fichier et chaque fichier est bien un fichier xls mais au format txt

Peux tu réexpliquer plus précisément ?

bonne soirée

michel

Le 28/05/2009 à 19:23

C'est pbre

Ton programme impose à ce que les noms des feuilles soient toutes identiques et se nomment "Feuil1". Or, le nom de mes feuilles de chaque fichier ont le nom des fichiers. Par exemple, si un des fichiers se nomme "CRA_EXPL_2090528.xls", la feuille de ce fichier se nomme aussi "CRA_EXPL_20090528"

Le deuxième point est que mes fichiers ont bien l'extension xls mais ils sont format texte

J'espère avoir été plus clair

Le 29/05/2009 à 12:29

Bonjour

Or, le nom de mes feuilles de chaque fichier ont le nom des fichiers. Par exemple, si un des fichiers se nomme "CRA_EXPL_2090528.xls", la feuille de ce fichier se nomme aussi "CRA_EXPL_20090528"

Est ce que tu as essayé sur un fichier en adaptant le nom de la feuille, afin de vérifier si la chaine de connexion est bien adaptée au format de ton fichier ?

Pour le reste, ce n'est pas facile de répondre plus en détail sans voir un fichier exemple.

De cela découlera la chaine de connexion ADO qui pourra ouvrir, puis lire, le fichier.

Le deuxième point est que mes fichiers ont bien l'extension xls mais ils sont format texte

s'il s'agit d'un classeur excel, ce ne sera pas compliqué d'adapter le nom de la feuille dans la procédure.

S'il s'agit en fait d'un fichier texte, la syntaxe sera dans le style :

Sub importFichierTexte_ADO()
    Dim Rc As ADODB.Recordset
    Dim cn As String, Chemin As String, Fichier As String
    Dim i As Long

    Chemin = "C:\Documents and Settings\michel\dossier"
    Fichier = "monFichier.txt"

    cn = "Driver={Microsoft Text Driver (*.txt; *.csv)};" & _
        "Dbq=" & Chemin & ";Extensions=asc,csv,tab,txt"

    Set Rc = New ADODB.Recordset
    Rc.Open Source:="SELECT * FROM " & Fichier & _
        " WHERE NomChamp = 'x'", ActiveConnection:=cn

bon week end

michel

Le 18/08/2009 à 17:00

J'ai pris du retour sur ce travail mais il est toujours d'actualité.

Cela fonctionne le premier programme mais il faut que je change chaque nom d'onglet par "Feuil1".

Les onglets de mes fichiers reprennent le nom de mon fichier et non "Feuil1" comme l'indique le lien

Est il possible de l'adapter à cette demande

merci d'avance

https://www.excel-pratique.com/~files/doc2/text_excel.doc

Le 28/08/2009 à 11:03

J'ai réussi à transformer mes fichier pour que la feuille de chaque fichier se nomme bien "Feuil1"

Or, maintenant en reprenant la macro initiale du début de texte, qui correspond à ceci

Sub Macro1()

'

'Sub tranfertClasseursFermes_VersFeuilleActive()

'Nécessite d'activer la référence

'Microsoft ActiveX Data Objects x.x Library

Dim cn As ADODB.Connection

Dim Rst As ADODB.Recordset

Dim j As Integer

Dim i As Long

Dim Fichier As String, Repertoire As String, Name As String

Name = "Feuil1"

i = 1

'Boucle sur les classeurs Excel du répertoire cible

Repertoire = "D:\DATAN\Test_Excel\Essai_2"

Fichier = Dir(Repertoire & "\*.xls")

Do While Fichier <> ""

'Connection au classeur Excel

Set cn = New ADODB.Connection

cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _

"Data Source=" & Repertoire & "\" & Fichier & ";" & _

"Extended Properties=""Excel 8.0;"""

'requête pour extraire les données de la Feuil1

Set Rst = New ADODB.Recordset

Rst.Open "SELECT * from [Feuil1]", cn, adOpenStatic

'Si la requete donne un resultat

If Not Rst.EOF Then

'S'il s'agit de la premiere ligne :

'on boucle sur les en-tetes afin d'en extraire les noms

If i = 1 Then

For j = 0 To Rst.Fields.Count - 1

Cells(i, j + 1) = Rst.Fields(j).Name

Next j

i = 2

End If

'Copie le résultat de la requete dans la feuille active

Range("A" & i).CopyFromRecordset Rst

'Récupère le numero de la premiere ligne vide pour la

'boucle suivante.

i = Range("A1").End(xlDown).Row + 1

End If

'Fermeture recordset

Rst.Close

Set Rst = Nothing

'Fermeture de la connection au classeur Excel

cn.Close

Set cn = Nothing

Fichier = Dir

Loop

End Sub

Maintenant, j'ai un message d'erreur voir fichier ci dessous

https://www.excel-pratique.com/~files/doc2/Message_erreur.jpg

Sur la ligne suivante :

https://www.excel-pratique.com/~files/doc2/Message_erreur1.jpg

Voici mes fichiers de données :

https://www.excel-pratique.com/~files/doc2/CRA_EXP_TRANS_REJET_6180954.xls

https://www.excel-pratique.com/~files/doc2/ECR_EXP_TRANS_REJET_6180566.xls

https://www.excel-pratique.com/~files/doc2/PLA_EXP_TRANS_REJET_6180720.xls

C'est urgent, quelqu'un peut il m'aider ? j'ai vérifié mon chemin et le nom des feuilles je ne trouve pas d'erreur

Le 28/01/2014 à 14:11

Bonjour,

Comment adapter ce code pour qu'il fonctionne avec les fichier contenu dans les sous dossiers du fichiers en cours et avec une/des plage(s) de cellule données.

Rechercher des sujets similaires à "regrouper lignes fichiers differents"