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) :
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...)
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"
VB:
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
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).
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?????
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
VB:
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
Pièces jointes
Exemple publié - Consolidation d'un répertoire.xlsm
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?????
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
VB:
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 ...)
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.
VB:
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