Consolidation de tous les fichiers d'un répertoire

[virgie]

Bonjour à tous,

Je cherche depuis 2 jours, mais je ne trouve pas de solution à mon problème :

Tous les fichiers de mon répertoire (T:\Communication\Virginie\_Bureautique\Applicatifs\non tit\retours\) ont la meme structure (il y en a des centaines).
Je voudrais consolider les données de toutes les feuilles ''collectivité'' (somme) dans un fichier nommé ''synthèse''(feuille synthèse générale), sans avoir à ouvrir puis selectionner la plage de cellules de chaque fichier.
L'idéal, serait qu'il sache qu'il faut aller chercher les cellules R23C4:R25C12 de toutes les feuilles ''collectivités'' des fichiers du répertoire. Mais ça je ne sais pas le faire...

Pour info, le fichier synthèse contiendra plusieurs onglets issus de consolidation d'autres feuilles présentes dans les autres onglets des fichiers (sous forme de liste - ca je sais pas encore comment faire...)

Voici la macro que j'ai utilisé et qu'il faudrait donc améliorer (J'ai fait le test pour 2 fichiers mais il y en a + de 100 fois plus) :

Sub consolidation3()
'
'
Range("D3").Select
Workbooks.Open Filename:= _
"T:\Communication\Virginie\_Bureautique\Applicatifs\non tit\retours\Eligibilite_non_titulaires_x.xls"
Workbooks.Open Filename:= _
"T:\Communication\Virginie\_Bureautique\Applicatifs\non tit\retours\Eligibilite_non_titulaires_x - Copie.xls"
Windows("Synthèse.xls").Activate
Selection.Consolidate Sources:=Array( _
"'T:\Communication\Virginie\_Bureautique\Applicatifs\non tit\retours\[Eligibilite_non_titulaires_x - Copie.xls]Collectivité'!R23C4:R25C12" _
, _
"'T:\Communication\Virginie\_Bureautique\Applicatifs\non tit\retours\[Eligibilite_non_titulaires_x.xls]Collectivité'!R23C4:R25C12" _
), Function:=xlSum, TopRow:=False, LeftColumn:=False, CreateLinks:=True
End Sub

J'espère que quelqu'un pourra me venir en aide.
Merci d'avance.

A vous lire.

 

[MichD]

Re : Consolidation de tous les fichiers d'un répertoire

Bonjour,

Pour ce faire, il faut une information précise :

A ) Chemin du répertoire : Ok
T:\Communication\Virginie\_Bureautique\Applicatif s\non tit\retours\

B ) Nom de la feuille contenant les données dans chaque fichier : ''collectivité' OK

C ) Plage des données à extraire dans chaque feuille : R23C4:R25C12 soit D23:L25 Ok
(il faut penser à oublier ce type de syntaxe : R23C4:R25C12)

D ) Est-ce que ces colonnes ont une étiquette de colonnes?

E ) Tu veux copier cette plage de cellule vers un tableau de destination?
- Nom de la feuille ?
- l'adresse de la première cellule où tu veux insérer ces données?

F )

Pour info, le fichier synthèse contiendra plusieurs onglets issus de consolidation d'autres feuilles présentes dans les autres onglets des fichiers (sous forme de liste - ca je sais pas encore comment faire...)

Je n'ai aucune idée de ce que tu veux faire et à quoi cela fait référence?

 

[MichD]

Re : Consolidation de tous les fichiers d'un répertoire

Une façon de faire :

Tu dois ajouter au projetVBA du classeur dans la fenêtre de l'éditeur de code / barre des menus /
Outils / Références, celle-ci : "Microsoft Activex Data Objects 6.0 Library"

J'ai supposé que la plage de cellules n'avait pas de ligne d'étiquette de colonnes
et que le nom de la feuille de destination des données était "Feuil2"

Sub Requête_Avec_ADO()

Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Nb As Long
Dim Chemin As String, NomFeuilleDestination As String

'***Variables à définir ou corriger si nécessaire******

NomFeuille = "Collectivité"
Chemin = "T:\Communication\Virginie\_Bureautique\Applicatif s\non tit\retours\"
adr = "D23:L25" 'plage de cellule à extraire dans chacune des feuilles
NomFeuilleDestination = "Feuil2" 'Nom de la feuille du fichier de consolitation
'Les données seront copiées dans la feuille de destination
'à partir de A1 ou de la première ligne vide de la colonne A:A
'dans la feuille de destination.
'********************************************************

'La requête qui sera exécutée 
Requete = "SELECT * FROM [" & NomFeuille & "$" & adr & "]"

'établir la connection avec le fichier...
Set Conn = New ADODB.Connection

'Extraire le nom du premier fichier du répertoire
File = Dir(Chemin & "\*.xl*")

'Boucle sur tous les fichiers Excel du répertoire
Do While File <> ""
    'Défini la première cellule où seront copiées les
    'données des requêtes ADO
    With Worksheets(NomFeuilleDestination)
        If .Range("A1") = "" Then
            Set Rg = .Range("A1")
        Else
            Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
        End If
    End With
    
     Conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source=" & Chemin & File & ";" & _
        "Extended Properties=""Excel 12.0;HDR=NO;"""

    Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
    'détermine le nombre de recordset
    Nb = Range(adr).Rows.Count
    
    'Copie des données vers la feuille de destination
    Rg.Resize(Nb, Rst.Fields.Count) = Application.Transpose(Rst.GetRows)
           
    'Passe au fichier suivant
    File = Dir()
    'Ferme le Recordset
    Rst.Close
    'Ferme la connexion vers le classeur qu'il vient d'ouvrir
    Conn.Close
Loop
'Libère l'espace mémoire occupée par les objets de la procédure
    Set Rst = Nothing: Set Conn = Nothing
    Set Rg = Nothing
End Sub

 

[virgie]

Re : Consolidation de tous les fichiers d'un répertoire

Bonjour MichD,

Merci pour ta réponse.
J'ai renommer feuil2 en synthese generale, mais quand je lance la macro, rien ne se passe.
J'ai pourtant bien activé la référence Microsoft Activex Data Objects 6.0 Library.

Je te joins le fichier de synthese pour que tu vois exactement de quoi il retourne...

Pour répondre à tes questions :
D - oui mes colonnes ont une étiquette de données (s'il s'agit bien d'une ligne de titre)
E - la page dans laquelle je veux coller mes données s'appelle synthese generale et je souhaite coller les information à partir de D3
F- Enfin, dans le fichier joint, il y a une feuille qui s'appelle ''conso CDI'', dans cette feuille, je souhaitais que toutes les données des feuilles nommées ''conso CDI'' de tous les fichiers du répertoire apparaissent les unes à à suite des autres (en ignorant les lignes vides si possible).

En tout cas, merci beaucoup de me venir en aide.

 

[MichD]

Re : Consolidation de tous les fichiers d'un répertoire

F- Enfin, dans le fichier joint, il y a une feuille qui s'appelle ''conso CDI'', dans cette feuille, je souhaitais que toutes les données des feuilles nommées ''conso CDI'' de tous les fichiers du répertoire apparaissent les unes à à suite des autres (en ignorant les lignes vides si possible).

Dans ta première intervention, le nom de la feuille dont tu voulais extraire les données s'appelait : Collectivité
maintenant c'est ''conso CDI''????? OU est-ce une nouvelle question?????

 

[MichD]

Re : Consolidation de tous les fichiers d'un répertoire

Voici un fichier exemple, tu n'as qu'à cliquer sur le bouton.

Si rien ne se passe, c'est qu'il y a un problème avec les variables.
Vérifie qu'il n'y a pas de faute d'orthographe!!!

Voici la nouvelle version du code avec des étiquettes de colonnes
Dans le code du fichier exemple, ajoute cette ligne de déclaration de variables à
la procédure : Dim NomFeuilleDestination As String, PlgDest As String

Sub Requête_Avec_ADO()

Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String, Nb As Long
Dim NomFeuilleDestination As String, PlgDest As String

'***Variables à définir ou corriger si nécessaire******

NomFeuille = "Collectivité"
Chemin = "T:\Communication\Virginie\_Bureautique\Applicatif s\non tit\retours\"
adr = "D23:L25" 'plage de cellule à extraire dans chacune des feuilles
NomFeuilleDestination = "synthese generale" 'Nom de la feuille du fichier de consolitation
PlgDest = "D3"

'********************************************************

'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * FROM [" & NomFeuille & "$" & adr & "]"

'établir la connection avec le fichier...
Set Conn = New ADODB.Connection

'Extraire le nom du premier fichier du répertoire
File = Dir(Chemin & "\*.xl*")

'Boucle sur tous les fichiers Excel du répertoire
Do While File <> ""
    'Défini la première cellule où seront copiées les
    'données des requêtes ADO
    With Worksheets(NomFeuilleDestination)
        If .Range(PlgDest) = "" Then
            Set Rg = .Range(PlgDest)
        Else
            Set Rg = .Range("D" & .Range("D65356").End(xlUp).Row)(2)
            Ok = 1
        End If
    End With
    
    Conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source=" & Chemin & File & ";" & _
        "Extended Properties=""Excel 12.0;HDR=YES;"""

    'Exécution de la requête
    Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
    'détermine le nombre de recordset
    Nb = Range(adr).Rows.Count - 1  'Copie les étiquettes du recordset vers Excel
    If Ok <> 1 Then
        Do
            'Copie dans la plage destination les étiquettes de colonne
            'de la plage source seulement pour le premier fichier.
            Rg.Offset(, C) = Rst.Fields(C).Name
            C = C + 1
            x = x + 1
        Loop Until x = Rst.Fields.Count
        'Copie les autres données
        Rg.Offset(1).Resize(Nb, Rst.Fields.Count) = Application.Transpose(Rst.GetRows)
    Else
        Rg.Resize(Nb, Rst.Fields.Count) = Application.Transpose(Rst.GetRows)
    End If
    File = Dir()
    Rst.Close
    Conn.Close
Loop
    Set Rst = Nothing: Set Conn = Nothing
    Set Rg = Nothing
End Sub

 

[virgie]

Re : Consolidation de tous les fichiers d'un répertoire

Dans ta première intervention, le nom de la feuille dont tu voulais extraire les données s'appelait : Collectivité
maintenant c'est ''conso CDI''????? OU est-ce une nouvelle question?????

Non, pas d'inquiétude, je répondais à la question numéro F) de ton 1er message (pour le travail qui me restaera à faire ensuite).

 

[virgie]

Re : Consolidation de tous les fichiers d'un répertoire

Voici un fichier exemple, tu n'as qu'à cliquer sur le bouton.

Si rien ne se passe, c'est qu'il y a un problème avec les variables.
Vérifie qu'il n'y a pas de faute d'orthographe!!!

Voici la nouvelle version du code avec des étiquettes de colonnes
Dans le code du fichier exemple, ajoute cette ligne de déclaration de variables à
la procédure : Dim NomFeuilleDestination As String, PlgDest As String

Sub Requête_Avec_ADO()

Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String, Nb As Long
Dim NomFeuilleDestination As String, PlgDest As String

'***Variables à définir ou corriger si nécessaire******

NomFeuille = "Collectivité"
Chemin = "T:\Communication\Virginie\_Bureautique\Applicatif s\non tit\retours\"
adr = "D23:L25" 'plage de cellule à extraire dans chacune des feuilles
NomFeuilleDestination = "synthese generale" 'Nom de la feuille du fichier de consolitation
PlgDest = "D3"

'********************************************************

'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * FROM [" & NomFeuille & "$" & adr & "]"

'établir la connection avec le fichier...
Set Conn = New ADODB.Connection

'Extraire le nom du premier fichier du répertoire
File = Dir(Chemin & "\*.xl*")

'Boucle sur tous les fichiers Excel du répertoire
Do While File <> ""
    'Défini la première cellule où seront copiées les
    'données des requêtes ADO
    With Worksheets(NomFeuilleDestination)
        If .Range(PlgDest) = "" Then
            Set Rg = .Range(PlgDest)
        Else
            Set Rg = .Range("D" & .Range("D65356").End(xlUp).Row)(2)
            Ok = 1
        End If
    End With
    
    Conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source=" & Chemin & File & ";" & _
        "Extended Properties=""Excel 12.0;HDR=YES;"""

    'Exécution de la requête
    Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
    'détermine le nombre de recordset
    Nb = Range(adr).Rows.Count - 1  'Copie les étiquettes du recordset vers Excel
    If Ok <> 1 Then
        Do
            'Copie dans la plage destination les étiquettes de colonne
            'de la plage source seulement pour le premier fichier.
            Rg.Offset(, C) = Rst.Fields(C).Name
            C = C + 1
            x = x + 1
        Loop Until x = Rst.Fields.Count
        'Copie les autres données
        Rg.Offset(1).Resize(Nb, Rst.Fields.Count) = Application.Transpose(Rst.GetRows)
    Else
     [U]   Rg.Resize(Nb, Rst.Fields.Count) = Application.Transpose(Rst.GetRows)[/U]
    End If
    File = Dir()
    Rst.Close
    Conn.Close
Loop
    Set Rst = Nothing: Set Conn = Nothing
    Set Rg = Nothing
End Sub

Lorsque je lance la macro, j'ai un message d'erreur Erreur d'exécution '13': Incompatibilité de type.
Il surligne la ligne Rg.Resize(Nb, Rst.Fields.Count) = Application.Transpose(Rst.GetRows) (que j'ai souligné plus haut ...)

 

[MichD]

Re : Consolidation de tous les fichiers d'un répertoire

Tu dois avoir dans un fichier une feuille qui ne contient pas d'enregistrement
dans la plage indiquée. En conséquence la variable Nb = 0 et
dans la méthode Resize, Nb ne peut pas être égale à 0 dans Rg.Resize(Nb, Rst.Fields.Count)

J'ai légèrement adapté la macro pour qu'elle tienne compte de cet était de fait.

Sub Requête_Avec_ADO()

Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String, Rg As Range
Dim File As String, C As Integer, Ok As Integer
Dim Chemin As String, Nb As Long

'***Variables à définir ou corriger si nécessaire******

NomFeuille = "Collectivité"
Chemin = "T:\Communication\Virginie\_Bureautique\Applicatif s\non tit\retours\"
adr = "D23:L25" 'plage de cellule à extraire dans chacune des feuilles
NomFeuilleDestination = "synthese generale" 'Nom de la feuille du fichier de consolitation
PlgDest = "D3"

'********************************************************

'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * FROM [" & NomFeuille & "$" & adr & "]"

'établir la connection avec le fichier...
Set Conn = New ADODB.Connection

'Extraire le nom du premier fichier du répertoire
File = Dir(Chemin & "\*.xl*")

'Boucle sur tous les fichiers Excel du répertoire
Do While File <> ""
    'Défini la première cellule où seront copiées les
    'données des requêtes ADO
    With Worksheets(NomFeuilleDestination)
        If .Range(PlgDest) = "" Then
            Set Rg = .Range(PlgDest)
        Else
            Set Rg = .Range("D" & .Range("D65356").End(xlUp).Row)(2)
            Ok = 1
        End If
    End With
    
    Conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source=" & Chemin & File & ";" & _
        "Extended Properties=""Excel 12.0;HDR=YES;"""

    'Exécution de la requête
    Rst.Open Requete, Conn, adOpenStatic, adLockOptimistic
    'détermine le nombre de recordset
    Nb = Rst.RecordCount
    If Nb > 0 Then
        If Ok <> 1 Then
            Do
                'Copie dans la plage destination les étiquettes de colonne
                'de la plage source seulement pour le premier fichier.
                Rg.Offset(, C) = Rst.Fields(C).Name
                C = C + 1
                x = x + 1
            Loop Until x = Rst.Fields.Count
            'Copie les autres données
            Rg.Offset(1).Resize(Nb, Rst.Fields.Count) = Application.Transpose(Rst.GetRows)
        Else
            Rg.Resize(Nb, Rst.Fields.Count) = Application.Transpose(Rst.GetRows)
        End If
    End If
    File = Dir()
    Rst.Close
    Conn.Close
Loop
    Set Rst = Nothing: Set Conn = Nothing
    Set Rg = Nothing
End Sub