Bonjour amenvoegen ,
Voici la procédure qui récupérera les données pour tous les
fichiers d'un même répertoire. Cela suppose que tous ces
fichiers possèdent une feuille ayant le même nom sur
laquelle se retrouve la même structure des données.
Pour adapter cette procédure à ton projet, tu dois définir :
A ) Le Chemin de ton répertoire
B ) Le nom de l'onglet de la feuille où sont les données
C ) Il te reste à écrire la requête pour extraire les données.
D ) Il est pris pour acquis que le classeur d'où sera exécuté
cette macro ne fait pas parti du répertoire visé... sinon
il faut modifier légèrement la macro.
Tu dois ajouter à ton fichier excel, la bibliothèque suivante :
"Microsoft Activex Data Objects 2.0 Librairy
Ceci a été testé avec Excel 97 et c'est OK
pour les autres versions -> adapter la méthode CopyFromRecordset
'-------------------------------------------
Sub MaRequêteAvecADO()
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
NomFeuille = "Feuil1" 'A déterminer
Chemin = "C:test" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil2")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
Rst.Open Requete, Conn, adOpenStatic, adLockOptimistic
Nb = Rst.RecordCount
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).Resize(Nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
Else
Rg.Resize(Nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
End If
File = Dir()
Rst.Close
Conn.Close
Loop
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'----------------------------------
Function TransposeSpecial2(ByRef Arr As Variant) As Variant
Dim A As Integer, B As Integer, Arr1() As Variant
Dim C As Integer, D As Integer
A = UBound(Arr, 1): B = UBound(Arr, 2)
ReDim Arr1(B, A)
For C = 0 To A
For D = 0 To B
Arr1(D, C) = Arr(C, D)
Next
Next
TransposeSpecial2 = (Arr1)
End Function
'-------------------------------------------
Salutations!
"samenvoegen van sheets" a écrit dans le message de news:
Bonjour,
J'aimerais consolider des données ce trouvant sur 20 feuilles differentes
dans 20 documents excel (la feuille concerné etant toujours la premiere
feuille de chaque document). Les differentes feuilles on le meme lay-out mais
contiennes des collonnes similaires et differentes.
En utilisant la fonction "consolider" mon text n'apparait pas sur ma feuille
consolidé. Que dois je faire?
Il y a t'il moyen de travailles avec la fonction "recherchev" pour
rechercher les donner dans les differents documents? si, oui comment faire?
Il y a t'il une solutioàn a mon probleme ...
merci beaucoup!!
florence
Bonjour amenvoegen ,
Voici la procédure qui récupérera les données pour tous les
fichiers d'un même répertoire. Cela suppose que tous ces
fichiers possèdent une feuille ayant le même nom sur
laquelle se retrouve la même structure des données.
Pour adapter cette procédure à ton projet, tu dois définir :
A ) Le Chemin de ton répertoire
B ) Le nom de l'onglet de la feuille où sont les données
C ) Il te reste à écrire la requête pour extraire les données.
D ) Il est pris pour acquis que le classeur d'où sera exécuté
cette macro ne fait pas parti du répertoire visé... sinon
il faut modifier légèrement la macro.
Tu dois ajouter à ton fichier excel, la bibliothèque suivante :
"Microsoft Activex Data Objects 2.0 Librairy
Ceci a été testé avec Excel 97 et c'est OK
pour les autres versions -> adapter la méthode CopyFromRecordset
'-------------------------------------------
Sub MaRequêteAvecADO()
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
NomFeuille = "Feuil1" 'A déterminer
Chemin = "C:test" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil2")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
Rst.Open Requete, Conn, adOpenStatic, adLockOptimistic
Nb = Rst.RecordCount
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).Resize(Nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
Else
Rg.Resize(Nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
End If
File = Dir()
Rst.Close
Conn.Close
Loop
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'----------------------------------
Function TransposeSpecial2(ByRef Arr As Variant) As Variant
Dim A As Integer, B As Integer, Arr1() As Variant
Dim C As Integer, D As Integer
A = UBound(Arr, 1): B = UBound(Arr, 2)
ReDim Arr1(B, A)
For C = 0 To A
For D = 0 To B
Arr1(D, C) = Arr(C, D)
Next
Next
TransposeSpecial2 = (Arr1)
End Function
'-------------------------------------------
Salutations!
"samenvoegen van sheets" <samenvoegenvansheets@discussions.microsoft.com> a écrit dans le message de news:
9BA83B18-8DD7-4B76-A6C0-281B690244D4@microsoft.com...
Bonjour,
J'aimerais consolider des données ce trouvant sur 20 feuilles differentes
dans 20 documents excel (la feuille concerné etant toujours la premiere
feuille de chaque document). Les differentes feuilles on le meme lay-out mais
contiennes des collonnes similaires et differentes.
En utilisant la fonction "consolider" mon text n'apparait pas sur ma feuille
consolidé. Que dois je faire?
Il y a t'il moyen de travailles avec la fonction "recherchev" pour
rechercher les donner dans les differents documents? si, oui comment faire?
Il y a t'il une solutioàn a mon probleme ...
merci beaucoup!!
florence
Bonjour amenvoegen ,
Voici la procédure qui récupérera les données pour tous les
fichiers d'un même répertoire. Cela suppose que tous ces
fichiers possèdent une feuille ayant le même nom sur
laquelle se retrouve la même structure des données.
Pour adapter cette procédure à ton projet, tu dois définir :
A ) Le Chemin de ton répertoire
B ) Le nom de l'onglet de la feuille où sont les données
C ) Il te reste à écrire la requête pour extraire les données.
D ) Il est pris pour acquis que le classeur d'où sera exécuté
cette macro ne fait pas parti du répertoire visé... sinon
il faut modifier légèrement la macro.
Tu dois ajouter à ton fichier excel, la bibliothèque suivante :
"Microsoft Activex Data Objects 2.0 Librairy
Ceci a été testé avec Excel 97 et c'est OK
pour les autres versions -> adapter la méthode CopyFromRecordset
'-------------------------------------------
Sub MaRequêteAvecADO()
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
NomFeuille = "Feuil1" 'A déterminer
Chemin = "C:test" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil2")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
Rst.Open Requete, Conn, adOpenStatic, adLockOptimistic
Nb = Rst.RecordCount
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).Resize(Nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
Else
Rg.Resize(Nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
End If
File = Dir()
Rst.Close
Conn.Close
Loop
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'----------------------------------
Function TransposeSpecial2(ByRef Arr As Variant) As Variant
Dim A As Integer, B As Integer, Arr1() As Variant
Dim C As Integer, D As Integer
A = UBound(Arr, 1): B = UBound(Arr, 2)
ReDim Arr1(B, A)
For C = 0 To A
For D = 0 To B
Arr1(D, C) = Arr(C, D)
Next
Next
TransposeSpecial2 = (Arr1)
End Function
'-------------------------------------------
Salutations!
"samenvoegen van sheets" a écrit dans le message de news:
Bonjour,
J'aimerais consolider des données ce trouvant sur 20 feuilles differentes
dans 20 documents excel (la feuille concerné etant toujours la premiere
feuille de chaque document). Les differentes feuilles on le meme lay-out mais
contiennes des collonnes similaires et differentes.
En utilisant la fonction "consolider" mon text n'apparait pas sur ma feuille
consolidé. Que dois je faire?
Il y a t'il moyen de travailles avec la fonction "recherchev" pour
rechercher les donner dans les differents documents? si, oui comment faire?
Il y a t'il une solutioàn a mon probleme ...
merci beaucoup!!
florence
Bonjour amenvoegen ,
Voici la procédure qui récupérera les données pour tous les
fichiers d'un même répertoire. Cela suppose que tous ces
fichiers possèdent une feuille ayant le même nom sur
laquelle se retrouve la même structure des données.
Pour adapter cette procédure à ton projet, tu dois définir :
A ) Le Chemin de ton répertoire
B ) Le nom de l'onglet de la feuille où sont les données
C ) Il te reste à écrire la requête pour extraire les données.
D ) Il est pris pour acquis que le classeur d'où sera exécuté
cette macro ne fait pas parti du répertoire visé... sinon
il faut modifier légèrement la macro.
Tu dois ajouter à ton fichier excel, la bibliothèque suivante :
"Microsoft Activex Data Objects 2.0 Librairy
Ceci a été testé avec Excel 97 et c'est OK
pour les autres versions -> adapter la méthode CopyFromRecordset
'-------------------------------------------
Sub MaRequêteAvecADO()
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
NomFeuille = "Feuil1" 'A déterminer
Chemin = "C:test" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil2")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
Rst.Open Requete, Conn, adOpenStatic, adLockOptimistic
Nb = Rst.RecordCount
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).Resize(Nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
Else
Rg.Resize(Nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
End If
File = Dir()
Rst.Close
Conn.Close
Loop
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'----------------------------------
Function TransposeSpecial2(ByRef Arr As Variant) As Variant
Dim A As Integer, B As Integer, Arr1() As Variant
Dim C As Integer, D As Integer
A = UBound(Arr, 1): B = UBound(Arr, 2)
ReDim Arr1(B, A)
For C = 0 To A
For D = 0 To B
Arr1(D, C) = Arr(C, D)
Next
Next
TransposeSpecial2 = (Arr1)
End Function
'-------------------------------------------
Salutations!
"samenvoegen van sheets" a écrit dans le message de news:
Bonjour,
J'aimerais consolider des données ce trouvant sur 20 feuilles differentes
dans 20 documents excel (la feuille concerné etant toujours la premiere
feuille de chaque document). Les differentes feuilles on le meme lay-out mais
contiennes des collonnes similaires et differentes.
En utilisant la fonction "consolider" mon text n'apparait pas sur ma feuille
consolidé. Que dois je faire?
Il y a t'il moyen de travailles avec la fonction "recherchev" pour
rechercher les donner dans les differents documents? si, oui comment faire?
Il y a t'il une solutioàn a mon probleme ...
merci beaucoup!!
florence
Bonjour amenvoegen ,
Voici la procédure qui récupérera les données pour tous les
fichiers d'un même répertoire. Cela suppose que tous ces
fichiers possèdent une feuille ayant le même nom sur
laquelle se retrouve la même structure des données.
Pour adapter cette procédure à ton projet, tu dois définir :
A ) Le Chemin de ton répertoire
B ) Le nom de l'onglet de la feuille où sont les données
C ) Il te reste à écrire la requête pour extraire les données.
D ) Il est pris pour acquis que le classeur d'où sera exécuté
cette macro ne fait pas parti du répertoire visé... sinon
il faut modifier légèrement la macro.
Tu dois ajouter à ton fichier excel, la bibliothèque suivante :
"Microsoft Activex Data Objects 2.0 Librairy
Ceci a été testé avec Excel 97 et c'est OK
pour les autres versions -> adapter la méthode CopyFromRecordset
'-------------------------------------------
Sub MaRequêteAvecADO()
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
NomFeuille = "Feuil1" 'A déterminer
Chemin = "C:test" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil2")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
Rst.Open Requete, Conn, adOpenStatic, adLockOptimistic
Nb = Rst.RecordCount
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).Resize(Nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
Else
Rg.Resize(Nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
End If
File = Dir()
Rst.Close
Conn.Close
Loop
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'----------------------------------
Function TransposeSpecial2(ByRef Arr As Variant) As Variant
Dim A As Integer, B As Integer, Arr1() As Variant
Dim C As Integer, D As Integer
A = UBound(Arr, 1): B = UBound(Arr, 2)
ReDim Arr1(B, A)
For C = 0 To A
For D = 0 To B
Arr1(D, C) = Arr(C, D)
Next
Next
TransposeSpecial2 = (Arr1)
End Function
'-------------------------------------------
Salutations!
"samenvoegen van sheets" <samenvoegenvansheets@discussions.microsoft.com> a écrit dans le message de news:
9BA83B18-8DD7-4B76-A6C0-281B690244D4@microsoft.com...
Bonjour,
J'aimerais consolider des données ce trouvant sur 20 feuilles differentes
dans 20 documents excel (la feuille concerné etant toujours la premiere
feuille de chaque document). Les differentes feuilles on le meme lay-out mais
contiennes des collonnes similaires et differentes.
En utilisant la fonction "consolider" mon text n'apparait pas sur ma feuille
consolidé. Que dois je faire?
Il y a t'il moyen de travailles avec la fonction "recherchev" pour
rechercher les donner dans les differents documents? si, oui comment faire?
Il y a t'il une solutioàn a mon probleme ...
merci beaucoup!!
florence
Bonjour amenvoegen ,
Voici la procédure qui récupérera les données pour tous les
fichiers d'un même répertoire. Cela suppose que tous ces
fichiers possèdent une feuille ayant le même nom sur
laquelle se retrouve la même structure des données.
Pour adapter cette procédure à ton projet, tu dois définir :
A ) Le Chemin de ton répertoire
B ) Le nom de l'onglet de la feuille où sont les données
C ) Il te reste à écrire la requête pour extraire les données.
D ) Il est pris pour acquis que le classeur d'où sera exécuté
cette macro ne fait pas parti du répertoire visé... sinon
il faut modifier légèrement la macro.
Tu dois ajouter à ton fichier excel, la bibliothèque suivante :
"Microsoft Activex Data Objects 2.0 Librairy
Ceci a été testé avec Excel 97 et c'est OK
pour les autres versions -> adapter la méthode CopyFromRecordset
'-------------------------------------------
Sub MaRequêteAvecADO()
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
NomFeuille = "Feuil1" 'A déterminer
Chemin = "C:test" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil2")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
Rst.Open Requete, Conn, adOpenStatic, adLockOptimistic
Nb = Rst.RecordCount
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).Resize(Nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
Else
Rg.Resize(Nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
End If
File = Dir()
Rst.Close
Conn.Close
Loop
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'----------------------------------
Function TransposeSpecial2(ByRef Arr As Variant) As Variant
Dim A As Integer, B As Integer, Arr1() As Variant
Dim C As Integer, D As Integer
A = UBound(Arr, 1): B = UBound(Arr, 2)
ReDim Arr1(B, A)
For C = 0 To A
For D = 0 To B
Arr1(D, C) = Arr(C, D)
Next
Next
TransposeSpecial2 = (Arr1)
End Function
'-------------------------------------------
Salutations!
"samenvoegen van sheets" a écrit dans le message de news:
Bonjour,
J'aimerais consolider des données ce trouvant sur 20 feuilles differentes
dans 20 documents excel (la feuille concerné etant toujours la premiere
feuille de chaque document). Les differentes feuilles on le meme lay-out mais
contiennes des collonnes similaires et differentes.
En utilisant la fonction "consolider" mon text n'apparait pas sur ma feuille
consolidé. Que dois je faire?
Il y a t'il moyen de travailles avec la fonction "recherchev" pour
rechercher les donner dans les differents documents? si, oui comment faire?
Il y a t'il une solutioàn a mon probleme ...
merci beaucoup!!
florence
Bonjour samenvoegen,
| Mais mon excel est en anglais et je ne sais pas si
| il prend les function ecrit en francais.
Le code devrait s'exécuter normalement sur une version
Excel anglaise ou française
"Microsoft Activex Data Objects 2.0 Librairy a mon excel?
Pour ajouter cette bibliothèque, tu ouvres VBE (visual basic editor) -> Alt + F11
Dans cette fenêtre, barre des menus / outils / références / et dans la fenêtre
qui s'ouvre tu coches la bibliothèque mentionnnée dans la liste.
Pour ce qui est du reste, à toi de définir les variables selon ton application.
NomFeuille = "Feuil1" 'A déterminer
Chemin = "C:test" 'à déterminer
Comme la procédure extrait toutes les données du nom de la feuille que tu
indiquera pour tous les classeurs de ce répertoire, la procédure suppose
que le classeur "Consolitation" se trouve dans un autre répertoire et ce afin
de ne pas intégrer dans la compilation les données 2 fois.
Salutations!
"samenvoegen van sheets" a écrit dans le message de news:
Bonjour michdenis,
merci pour ta reponse.
Le probleme est que je ne suis pas une pro d'excel, je suppose que je dois
copier ceci dans un macro. Mais mon excel est en anglais et je ne sais pas si
il prend les function ecrit en francais.
pourrais tu m'aider a traduire cette fonction en anglais?
supposons que:
1.mes documents ce trouve dans: C:MSLM testMars sheets for consolidation
2.mes documents se nomment tous "MARSPricingSheet" avec un numero derriere
3.la premiere feuille de chaque document est "lines"
Si j'ai bien compris je doit faire demarrer ce macro appartir d'un document
qui ne se trouve pas dans la meme farde mais comment dois ajouter "Microsoft
Activex Data Objects 2.0 Librairy a mon excel?
peux tu m'aider encore un peu?
merci bcp,
florenceBonjour amenvoegen ,
Voici la procédure qui récupérera les données pour tous les
fichiers d'un même répertoire. Cela suppose que tous ces
fichiers possèdent une feuille ayant le même nom sur
laquelle se retrouve la même structure des données.
Pour adapter cette procédure à ton projet, tu dois définir :
A ) Le Chemin de ton répertoire
B ) Le nom de l'onglet de la feuille où sont les données
C ) Il te reste à écrire la requête pour extraire les données.
D ) Il est pris pour acquis que le classeur d'où sera exécuté
cette macro ne fait pas parti du répertoire visé... sinon
il faut modifier légèrement la macro.
Tu dois ajouter à ton fichier excel, la bibliothèque suivante :
"Microsoft Activex Data Objects 2.0 Librairy
Ceci a été testé avec Excel 97 et c'est OK
pour les autres versions -> adapter la méthode CopyFromRecordset
'-------------------------------------------
Sub MaRequêteAvecADO()
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
NomFeuille = "Feuil1" 'A déterminer
Chemin = "C:test" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil2")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
Rst.Open Requete, Conn, adOpenStatic, adLockOptimistic
Nb = Rst.RecordCount
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).Resize(Nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
Else
Rg.Resize(Nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
End If
File = Dir()
Rst.Close
Conn.Close
Loop
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'----------------------------------
Function TransposeSpecial2(ByRef Arr As Variant) As Variant
Dim A As Integer, B As Integer, Arr1() As Variant
Dim C As Integer, D As Integer
A = UBound(Arr, 1): B = UBound(Arr, 2)
ReDim Arr1(B, A)
For C = 0 To A
For D = 0 To B
Arr1(D, C) = Arr(C, D)
Next
Next
TransposeSpecial2 = (Arr1)
End Function
'-------------------------------------------
Salutations!
"samenvoegen van sheets" a écrit dans le message de news:
Bonjour,
J'aimerais consolider des données ce trouvant sur 20 feuilles differentes
dans 20 documents excel (la feuille concerné etant toujours la premiere
feuille de chaque document). Les differentes feuilles on le meme lay-out mais
contiennes des collonnes similaires et differentes.
En utilisant la fonction "consolider" mon text n'apparait pas sur ma feuille
consolidé. Que dois je faire?
Il y a t'il moyen de travailles avec la fonction "recherchev" pour
rechercher les donner dans les differents documents? si, oui comment faire?
Il y a t'il une solutioàn a mon probleme ...
merci beaucoup!!
florence
Bonjour samenvoegen,
| Mais mon excel est en anglais et je ne sais pas si
| il prend les function ecrit en francais.
Le code devrait s'exécuter normalement sur une version
Excel anglaise ou française
"Microsoft Activex Data Objects 2.0 Librairy a mon excel?
Pour ajouter cette bibliothèque, tu ouvres VBE (visual basic editor) -> Alt + F11
Dans cette fenêtre, barre des menus / outils / références / et dans la fenêtre
qui s'ouvre tu coches la bibliothèque mentionnnée dans la liste.
Pour ce qui est du reste, à toi de définir les variables selon ton application.
NomFeuille = "Feuil1" 'A déterminer
Chemin = "C:test" 'à déterminer
Comme la procédure extrait toutes les données du nom de la feuille que tu
indiquera pour tous les classeurs de ce répertoire, la procédure suppose
que le classeur "Consolitation" se trouve dans un autre répertoire et ce afin
de ne pas intégrer dans la compilation les données 2 fois.
Salutations!
"samenvoegen van sheets" <samenvoegenvansheets@discussions.microsoft.com> a écrit dans le message de news:
C3155D12-9CE0-4DED-A569-2467AD88684F@microsoft.com...
Bonjour michdenis,
merci pour ta reponse.
Le probleme est que je ne suis pas une pro d'excel, je suppose que je dois
copier ceci dans un macro. Mais mon excel est en anglais et je ne sais pas si
il prend les function ecrit en francais.
pourrais tu m'aider a traduire cette fonction en anglais?
supposons que:
1.mes documents ce trouve dans: C:MSLM testMars sheets for consolidation
2.mes documents se nomment tous "MARSPricingSheet" avec un numero derriere
3.la premiere feuille de chaque document est "lines"
Si j'ai bien compris je doit faire demarrer ce macro appartir d'un document
qui ne se trouve pas dans la meme farde mais comment dois ajouter "Microsoft
Activex Data Objects 2.0 Librairy a mon excel?
peux tu m'aider encore un peu?
merci bcp,
florence
Bonjour amenvoegen ,
Voici la procédure qui récupérera les données pour tous les
fichiers d'un même répertoire. Cela suppose que tous ces
fichiers possèdent une feuille ayant le même nom sur
laquelle se retrouve la même structure des données.
Pour adapter cette procédure à ton projet, tu dois définir :
A ) Le Chemin de ton répertoire
B ) Le nom de l'onglet de la feuille où sont les données
C ) Il te reste à écrire la requête pour extraire les données.
D ) Il est pris pour acquis que le classeur d'où sera exécuté
cette macro ne fait pas parti du répertoire visé... sinon
il faut modifier légèrement la macro.
Tu dois ajouter à ton fichier excel, la bibliothèque suivante :
"Microsoft Activex Data Objects 2.0 Librairy
Ceci a été testé avec Excel 97 et c'est OK
pour les autres versions -> adapter la méthode CopyFromRecordset
'-------------------------------------------
Sub MaRequêteAvecADO()
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
NomFeuille = "Feuil1" 'A déterminer
Chemin = "C:test" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil2")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
Rst.Open Requete, Conn, adOpenStatic, adLockOptimistic
Nb = Rst.RecordCount
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).Resize(Nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
Else
Rg.Resize(Nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
End If
File = Dir()
Rst.Close
Conn.Close
Loop
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'----------------------------------
Function TransposeSpecial2(ByRef Arr As Variant) As Variant
Dim A As Integer, B As Integer, Arr1() As Variant
Dim C As Integer, D As Integer
A = UBound(Arr, 1): B = UBound(Arr, 2)
ReDim Arr1(B, A)
For C = 0 To A
For D = 0 To B
Arr1(D, C) = Arr(C, D)
Next
Next
TransposeSpecial2 = (Arr1)
End Function
'-------------------------------------------
Salutations!
"samenvoegen van sheets" <samenvoegenvansheets@discussions.microsoft.com> a écrit dans le message de news:
9BA83B18-8DD7-4B76-A6C0-281B690244D4@microsoft.com...
Bonjour,
J'aimerais consolider des données ce trouvant sur 20 feuilles differentes
dans 20 documents excel (la feuille concerné etant toujours la premiere
feuille de chaque document). Les differentes feuilles on le meme lay-out mais
contiennes des collonnes similaires et differentes.
En utilisant la fonction "consolider" mon text n'apparait pas sur ma feuille
consolidé. Que dois je faire?
Il y a t'il moyen de travailles avec la fonction "recherchev" pour
rechercher les donner dans les differents documents? si, oui comment faire?
Il y a t'il une solutioàn a mon probleme ...
merci beaucoup!!
florence
Bonjour samenvoegen,
| Mais mon excel est en anglais et je ne sais pas si
| il prend les function ecrit en francais.
Le code devrait s'exécuter normalement sur une version
Excel anglaise ou française
"Microsoft Activex Data Objects 2.0 Librairy a mon excel?
Pour ajouter cette bibliothèque, tu ouvres VBE (visual basic editor) -> Alt + F11
Dans cette fenêtre, barre des menus / outils / références / et dans la fenêtre
qui s'ouvre tu coches la bibliothèque mentionnnée dans la liste.
Pour ce qui est du reste, à toi de définir les variables selon ton application.
NomFeuille = "Feuil1" 'A déterminer
Chemin = "C:test" 'à déterminer
Comme la procédure extrait toutes les données du nom de la feuille que tu
indiquera pour tous les classeurs de ce répertoire, la procédure suppose
que le classeur "Consolitation" se trouve dans un autre répertoire et ce afin
de ne pas intégrer dans la compilation les données 2 fois.
Salutations!
"samenvoegen van sheets" a écrit dans le message de news:
Bonjour michdenis,
merci pour ta reponse.
Le probleme est que je ne suis pas une pro d'excel, je suppose que je dois
copier ceci dans un macro. Mais mon excel est en anglais et je ne sais pas si
il prend les function ecrit en francais.
pourrais tu m'aider a traduire cette fonction en anglais?
supposons que:
1.mes documents ce trouve dans: C:MSLM testMars sheets for consolidation
2.mes documents se nomment tous "MARSPricingSheet" avec un numero derriere
3.la premiere feuille de chaque document est "lines"
Si j'ai bien compris je doit faire demarrer ce macro appartir d'un document
qui ne se trouve pas dans la meme farde mais comment dois ajouter "Microsoft
Activex Data Objects 2.0 Librairy a mon excel?
peux tu m'aider encore un peu?
merci bcp,
florenceBonjour amenvoegen ,
Voici la procédure qui récupérera les données pour tous les
fichiers d'un même répertoire. Cela suppose que tous ces
fichiers possèdent une feuille ayant le même nom sur
laquelle se retrouve la même structure des données.
Pour adapter cette procédure à ton projet, tu dois définir :
A ) Le Chemin de ton répertoire
B ) Le nom de l'onglet de la feuille où sont les données
C ) Il te reste à écrire la requête pour extraire les données.
D ) Il est pris pour acquis que le classeur d'où sera exécuté
cette macro ne fait pas parti du répertoire visé... sinon
il faut modifier légèrement la macro.
Tu dois ajouter à ton fichier excel, la bibliothèque suivante :
"Microsoft Activex Data Objects 2.0 Librairy
Ceci a été testé avec Excel 97 et c'est OK
pour les autres versions -> adapter la méthode CopyFromRecordset
'-------------------------------------------
Sub MaRequêteAvecADO()
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
NomFeuille = "Feuil1" 'A déterminer
Chemin = "C:test" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil2")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
Rst.Open Requete, Conn, adOpenStatic, adLockOptimistic
Nb = Rst.RecordCount
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).Resize(Nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
Else
Rg.Resize(Nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
End If
File = Dir()
Rst.Close
Conn.Close
Loop
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'----------------------------------
Function TransposeSpecial2(ByRef Arr As Variant) As Variant
Dim A As Integer, B As Integer, Arr1() As Variant
Dim C As Integer, D As Integer
A = UBound(Arr, 1): B = UBound(Arr, 2)
ReDim Arr1(B, A)
For C = 0 To A
For D = 0 To B
Arr1(D, C) = Arr(C, D)
Next
Next
TransposeSpecial2 = (Arr1)
End Function
'-------------------------------------------
Salutations!
"samenvoegen van sheets" a écrit dans le message de news:
Bonjour,
J'aimerais consolider des données ce trouvant sur 20 feuilles differentes
dans 20 documents excel (la feuille concerné etant toujours la premiere
feuille de chaque document). Les differentes feuilles on le meme lay-out mais
contiennes des collonnes similaires et differentes.
En utilisant la fonction "consolider" mon text n'apparait pas sur ma feuille
consolidé. Que dois je faire?
Il y a t'il moyen de travailles avec la fonction "recherchev" pour
rechercher les donner dans les differents documents? si, oui comment faire?
Il y a t'il une solutioàn a mon probleme ...
merci beaucoup!!
florence
Bonjour samenvoegen,
| Mais mon excel est en anglais et je ne sais pas si
| il prend les function ecrit en francais.
Le code devrait s'exécuter normalement sur une version
Excel anglaise ou française
"Microsoft Activex Data Objects 2.0 Librairy a mon excel?
Pour ajouter cette bibliothèque, tu ouvres VBE (visual basic editor) -> Alt + F11
Dans cette fenêtre, barre des menus / outils / références / et dans la fenêtre
qui s'ouvre tu coches la bibliothèque mentionnnée dans la liste.
Pour ce qui est du reste, à toi de définir les variables selon ton application.
NomFeuille = "Feuil1" 'A déterminer
Chemin = "C:test" 'à déterminer
Comme la procédure extrait toutes les données du nom de la feuille que tu
indiquera pour tous les classeurs de ce répertoire, la procédure suppose
que le classeur "Consolitation" se trouve dans un autre répertoire et ce afin
de ne pas intégrer dans la compilation les données 2 fois.
Salutations!
"samenvoegen van sheets" a écrit dans le message de news:
Bonjour michdenis,
merci pour ta reponse.
Le probleme est que je ne suis pas une pro d'excel, je suppose que je dois
copier ceci dans un macro. Mais mon excel est en anglais et je ne sais pas si
il prend les function ecrit en francais.
pourrais tu m'aider a traduire cette fonction en anglais?
supposons que:
1.mes documents ce trouve dans: C:MSLM testMars sheets for consolidation
2.mes documents se nomment tous "MARSPricingSheet" avec un numero derriere
3.la premiere feuille de chaque document est "lines"
Si j'ai bien compris je doit faire demarrer ce macro appartir d'un document
qui ne se trouve pas dans la meme farde mais comment dois ajouter "Microsoft
Activex Data Objects 2.0 Librairy a mon excel?
peux tu m'aider encore un peu?
merci bcp,
florenceBonjour amenvoegen ,
Voici la procédure qui récupérera les données pour tous les
fichiers d'un même répertoire. Cela suppose que tous ces
fichiers possèdent une feuille ayant le même nom sur
laquelle se retrouve la même structure des données.
Pour adapter cette procédure à ton projet, tu dois définir :
A ) Le Chemin de ton répertoire
B ) Le nom de l'onglet de la feuille où sont les données
C ) Il te reste à écrire la requête pour extraire les données.
D ) Il est pris pour acquis que le classeur d'où sera exécuté
cette macro ne fait pas parti du répertoire visé... sinon
il faut modifier légèrement la macro.
Tu dois ajouter à ton fichier excel, la bibliothèque suivante :
"Microsoft Activex Data Objects 2.0 Librairy
Ceci a été testé avec Excel 97 et c'est OK
pour les autres versions -> adapter la méthode CopyFromRecordset
'-------------------------------------------
Sub MaRequêteAvecADO()
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
NomFeuille = "Feuil1" 'A déterminer
Chemin = "C:test" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil2")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
Rst.Open Requete, Conn, adOpenStatic, adLockOptimistic
Nb = Rst.RecordCount
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).Resize(Nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
Else
Rg.Resize(Nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
End If
File = Dir()
Rst.Close
Conn.Close
Loop
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'----------------------------------
Function TransposeSpecial2(ByRef Arr As Variant) As Variant
Dim A As Integer, B As Integer, Arr1() As Variant
Dim C As Integer, D As Integer
A = UBound(Arr, 1): B = UBound(Arr, 2)
ReDim Arr1(B, A)
For C = 0 To A
For D = 0 To B
Arr1(D, C) = Arr(C, D)
Next
Next
TransposeSpecial2 = (Arr1)
End Function
'-------------------------------------------
Salutations!
"samenvoegen van sheets" a écrit dans le message de news:
Bonjour,
J'aimerais consolider des données ce trouvant sur 20 feuilles differentes
dans 20 documents excel (la feuille concerné etant toujours la premiere
feuille de chaque document). Les differentes feuilles on le meme lay-out mais
contiennes des collonnes similaires et differentes.
En utilisant la fonction "consolider" mon text n'apparait pas sur ma feuille
consolidé. Que dois je faire?
Il y a t'il moyen de travailles avec la fonction "recherchev" pour
rechercher les donner dans les differents documents? si, oui comment faire?
Il y a t'il une solutioàn a mon probleme ...
merci beaucoup!!
florence
Bonjour samenvoegen,
| Mais mon excel est en anglais et je ne sais pas si
| il prend les function ecrit en francais.
Le code devrait s'exécuter normalement sur une version
Excel anglaise ou française
"Microsoft Activex Data Objects 2.0 Librairy a mon excel?
Pour ajouter cette bibliothèque, tu ouvres VBE (visual basic editor) -> Alt + F11
Dans cette fenêtre, barre des menus / outils / références / et dans la fenêtre
qui s'ouvre tu coches la bibliothèque mentionnnée dans la liste.
Pour ce qui est du reste, à toi de définir les variables selon ton application.
NomFeuille = "Feuil1" 'A déterminer
Chemin = "C:test" 'à déterminer
Comme la procédure extrait toutes les données du nom de la feuille que tu
indiquera pour tous les classeurs de ce répertoire, la procédure suppose
que le classeur "Consolitation" se trouve dans un autre répertoire et ce afin
de ne pas intégrer dans la compilation les données 2 fois.
Salutations!
"samenvoegen van sheets" <samenvoegenvansheets@discussions.microsoft.com> a écrit dans le message de news:
C3155D12-9CE0-4DED-A569-2467AD88684F@microsoft.com...
Bonjour michdenis,
merci pour ta reponse.
Le probleme est que je ne suis pas une pro d'excel, je suppose que je dois
copier ceci dans un macro. Mais mon excel est en anglais et je ne sais pas si
il prend les function ecrit en francais.
pourrais tu m'aider a traduire cette fonction en anglais?
supposons que:
1.mes documents ce trouve dans: C:MSLM testMars sheets for consolidation
2.mes documents se nomment tous "MARSPricingSheet" avec un numero derriere
3.la premiere feuille de chaque document est "lines"
Si j'ai bien compris je doit faire demarrer ce macro appartir d'un document
qui ne se trouve pas dans la meme farde mais comment dois ajouter "Microsoft
Activex Data Objects 2.0 Librairy a mon excel?
peux tu m'aider encore un peu?
merci bcp,
florence
Bonjour amenvoegen ,
Voici la procédure qui récupérera les données pour tous les
fichiers d'un même répertoire. Cela suppose que tous ces
fichiers possèdent une feuille ayant le même nom sur
laquelle se retrouve la même structure des données.
Pour adapter cette procédure à ton projet, tu dois définir :
A ) Le Chemin de ton répertoire
B ) Le nom de l'onglet de la feuille où sont les données
C ) Il te reste à écrire la requête pour extraire les données.
D ) Il est pris pour acquis que le classeur d'où sera exécuté
cette macro ne fait pas parti du répertoire visé... sinon
il faut modifier légèrement la macro.
Tu dois ajouter à ton fichier excel, la bibliothèque suivante :
"Microsoft Activex Data Objects 2.0 Librairy
Ceci a été testé avec Excel 97 et c'est OK
pour les autres versions -> adapter la méthode CopyFromRecordset
'-------------------------------------------
Sub MaRequêteAvecADO()
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
NomFeuille = "Feuil1" 'A déterminer
Chemin = "C:test" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil2")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
Rst.Open Requete, Conn, adOpenStatic, adLockOptimistic
Nb = Rst.RecordCount
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).Resize(Nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
Else
Rg.Resize(Nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
End If
File = Dir()
Rst.Close
Conn.Close
Loop
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'----------------------------------
Function TransposeSpecial2(ByRef Arr As Variant) As Variant
Dim A As Integer, B As Integer, Arr1() As Variant
Dim C As Integer, D As Integer
A = UBound(Arr, 1): B = UBound(Arr, 2)
ReDim Arr1(B, A)
For C = 0 To A
For D = 0 To B
Arr1(D, C) = Arr(C, D)
Next
Next
TransposeSpecial2 = (Arr1)
End Function
'-------------------------------------------
Salutations!
"samenvoegen van sheets" <samenvoegenvansheets@discussions.microsoft.com> a écrit dans le message de news:
9BA83B18-8DD7-4B76-A6C0-281B690244D4@microsoft.com...
Bonjour,
J'aimerais consolider des données ce trouvant sur 20 feuilles differentes
dans 20 documents excel (la feuille concerné etant toujours la premiere
feuille de chaque document). Les differentes feuilles on le meme lay-out mais
contiennes des collonnes similaires et differentes.
En utilisant la fonction "consolider" mon text n'apparait pas sur ma feuille
consolidé. Que dois je faire?
Il y a t'il moyen de travailles avec la fonction "recherchev" pour
rechercher les donner dans les differents documents? si, oui comment faire?
Il y a t'il une solutioàn a mon probleme ...
merci beaucoup!!
florence
Bonjour samenvoegen,
| Mais mon excel est en anglais et je ne sais pas si
| il prend les function ecrit en francais.
Le code devrait s'exécuter normalement sur une version
Excel anglaise ou française
"Microsoft Activex Data Objects 2.0 Librairy a mon excel?
Pour ajouter cette bibliothèque, tu ouvres VBE (visual basic editor) -> Alt + F11
Dans cette fenêtre, barre des menus / outils / références / et dans la fenêtre
qui s'ouvre tu coches la bibliothèque mentionnnée dans la liste.
Pour ce qui est du reste, à toi de définir les variables selon ton application.
NomFeuille = "Feuil1" 'A déterminer
Chemin = "C:test" 'à déterminer
Comme la procédure extrait toutes les données du nom de la feuille que tu
indiquera pour tous les classeurs de ce répertoire, la procédure suppose
que le classeur "Consolitation" se trouve dans un autre répertoire et ce afin
de ne pas intégrer dans la compilation les données 2 fois.
Salutations!
"samenvoegen van sheets" a écrit dans le message de news:
Bonjour michdenis,
merci pour ta reponse.
Le probleme est que je ne suis pas une pro d'excel, je suppose que je dois
copier ceci dans un macro. Mais mon excel est en anglais et je ne sais pas si
il prend les function ecrit en francais.
pourrais tu m'aider a traduire cette fonction en anglais?
supposons que:
1.mes documents ce trouve dans: C:MSLM testMars sheets for consolidation
2.mes documents se nomment tous "MARSPricingSheet" avec un numero derriere
3.la premiere feuille de chaque document est "lines"
Si j'ai bien compris je doit faire demarrer ce macro appartir d'un document
qui ne se trouve pas dans la meme farde mais comment dois ajouter "Microsoft
Activex Data Objects 2.0 Librairy a mon excel?
peux tu m'aider encore un peu?
merci bcp,
florenceBonjour amenvoegen ,
Voici la procédure qui récupérera les données pour tous les
fichiers d'un même répertoire. Cela suppose que tous ces
fichiers possèdent une feuille ayant le même nom sur
laquelle se retrouve la même structure des données.
Pour adapter cette procédure à ton projet, tu dois définir :
A ) Le Chemin de ton répertoire
B ) Le nom de l'onglet de la feuille où sont les données
C ) Il te reste à écrire la requête pour extraire les données.
D ) Il est pris pour acquis que le classeur d'où sera exécuté
cette macro ne fait pas parti du répertoire visé... sinon
il faut modifier légèrement la macro.
Tu dois ajouter à ton fichier excel, la bibliothèque suivante :
"Microsoft Activex Data Objects 2.0 Librairy
Ceci a été testé avec Excel 97 et c'est OK
pour les autres versions -> adapter la méthode CopyFromRecordset
'-------------------------------------------
Sub MaRequêteAvecADO()
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
NomFeuille = "Feuil1" 'A déterminer
Chemin = "C:test" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil2")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
Rst.Open Requete, Conn, adOpenStatic, adLockOptimistic
Nb = Rst.RecordCount
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).Resize(Nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
Else
Rg.Resize(Nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
End If
File = Dir()
Rst.Close
Conn.Close
Loop
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'----------------------------------
Function TransposeSpecial2(ByRef Arr As Variant) As Variant
Dim A As Integer, B As Integer, Arr1() As Variant
Dim C As Integer, D As Integer
A = UBound(Arr, 1): B = UBound(Arr, 2)
ReDim Arr1(B, A)
For C = 0 To A
For D = 0 To B
Arr1(D, C) = Arr(C, D)
Next
Next
TransposeSpecial2 = (Arr1)
End Function
'-------------------------------------------
Salutations!
"samenvoegen van sheets" a écrit dans le message de news:
Bonjour,
J'aimerais consolider des données ce trouvant sur 20 feuilles differentes
dans 20 documents excel (la feuille concerné etant toujours la premiere
feuille de chaque document). Les differentes feuilles on le meme lay-out mais
contiennes des collonnes similaires et differentes.
En utilisant la fonction "consolider" mon text n'apparait pas sur ma feuille
consolidé. Que dois je faire?
Il y a t'il moyen de travailles avec la fonction "recherchev" pour
rechercher les donner dans les differents documents? si, oui comment faire?
Il y a t'il une solutioàn a mon probleme ...
merci beaucoup!!
florence
| et quand j'appuie sur debug la ligne:
| With Worksheets("feuil2")
| est jaune.
As-tu dans ton classeur une feuille dont l'onglet est "Feuil2" ?
Sinon, donne un nom qui appartient à ton classeur...
Salutations!
"samenvoegen van sheets" a écrit dans le message de news:
Merci encore de bien vouloir m'aider,
J'ai donc ajouter "Microsoft Activex Data Objects 2.0 Librairy" et defini
les variable de l'application. pourtant il me donne une erreure.
"run time error 9" Subscrip ou of range...
que dois je faire.
encore merci
Bonjour samenvoegen,
| Mais mon excel est en anglais et je ne sais pas si
| il prend les function ecrit en francais.
Le code devrait s'exécuter normalement sur une version
Excel anglaise ou française
"Microsoft Activex Data Objects 2.0 Librairy a mon excel?
Pour ajouter cette bibliothèque, tu ouvres VBE (visual basic editor) -> Alt + F11
Dans cette fenêtre, barre des menus / outils / références / et dans la fenêtre
qui s'ouvre tu coches la bibliothèque mentionnnée dans la liste.
Pour ce qui est du reste, à toi de définir les variables selon ton application.
NomFeuille = "Feuil1" 'A déterminer
Chemin = "C:test" 'à déterminer
Comme la procédure extrait toutes les données du nom de la feuille que tu
indiquera pour tous les classeurs de ce répertoire, la procédure suppose
que le classeur "Consolitation" se trouve dans un autre répertoire et ce afin
de ne pas intégrer dans la compilation les données 2 fois.
Salutations!
"samenvoegen van sheets" a écrit dans le message de news:
Bonjour michdenis,
merci pour ta reponse.
Le probleme est que je ne suis pas une pro d'excel, je suppose que je dois
copier ceci dans un macro. Mais mon excel est en anglais et je ne sais pas si
il prend les function ecrit en francais.
pourrais tu m'aider a traduire cette fonction en anglais?
supposons que:
1.mes documents ce trouve dans: C:MSLM testMars sheets for consolidation
2.mes documents se nomment tous "MARSPricingSheet" avec un numero derriere
3.la premiere feuille de chaque document est "lines"
Si j'ai bien compris je doit faire demarrer ce macro appartir d'un document
qui ne se trouve pas dans la meme farde mais comment dois ajouter "Microsoft
Activex Data Objects 2.0 Librairy a mon excel?
peux tu m'aider encore un peu?
merci bcp,
florenceBonjour amenvoegen ,
Voici la procédure qui récupérera les données pour tous les
fichiers d'un même répertoire. Cela suppose que tous ces
fichiers possèdent une feuille ayant le même nom sur
laquelle se retrouve la même structure des données.
Pour adapter cette procédure à ton projet, tu dois définir :
A ) Le Chemin de ton répertoire
B ) Le nom de l'onglet de la feuille où sont les données
C ) Il te reste à écrire la requête pour extraire les données.
D ) Il est pris pour acquis que le classeur d'où sera exécuté
cette macro ne fait pas parti du répertoire visé... sinon
il faut modifier légèrement la macro.
Tu dois ajouter à ton fichier excel, la bibliothèque suivante :
"Microsoft Activex Data Objects 2.0 Librairy
Ceci a été testé avec Excel 97 et c'est OK
pour les autres versions -> adapter la méthode CopyFromRecordset
'-------------------------------------------
Sub MaRequêteAvecADO()
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
NomFeuille = "Feuil1" 'A déterminer
Chemin = "C:test" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil2")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
Rst.Open Requete, Conn, adOpenStatic, adLockOptimistic
Nb = Rst.RecordCount
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).Resize(Nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
Else
Rg.Resize(Nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
End If
File = Dir()
Rst.Close
Conn.Close
Loop
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'----------------------------------
Function TransposeSpecial2(ByRef Arr As Variant) As Variant
Dim A As Integer, B As Integer, Arr1() As Variant
Dim C As Integer, D As Integer
A = UBound(Arr, 1): B = UBound(Arr, 2)
ReDim Arr1(B, A)
For C = 0 To A
For D = 0 To B
Arr1(D, C) = Arr(C, D)
Next
Next
TransposeSpecial2 = (Arr1)
End Function
'-------------------------------------------
Salutations!
"samenvoegen van sheets" a écrit dans le message de news:
Bonjour,
J'aimerais consolider des données ce trouvant sur 20 feuilles differentes
dans 20 documents excel (la feuille concerné etant toujours la premiere
feuille de chaque document). Les differentes feuilles on le meme lay-out mais
contiennes des collonnes similaires et differentes.
En utilisant la fonction "consolider" mon text n'apparait pas sur ma feuille
consolidé. Que dois je faire?
Il y a t'il moyen de travailles avec la fonction "recherchev" pour
rechercher les donner dans les differents documents? si, oui comment faire?
Il y a t'il une solutioàn a mon probleme ...
merci beaucoup!!
florence
| et quand j'appuie sur debug la ligne:
| With Worksheets("feuil2")
| est jaune.
As-tu dans ton classeur une feuille dont l'onglet est "Feuil2" ?
Sinon, donne un nom qui appartient à ton classeur...
Salutations!
"samenvoegen van sheets" <samenvoegenvansheets@discussions.microsoft.com> a écrit dans le message de news:
58F9E6BA-61B7-4038-8694-ADF85D9D6326@microsoft.com...
Merci encore de bien vouloir m'aider,
J'ai donc ajouter "Microsoft Activex Data Objects 2.0 Librairy" et defini
les variable de l'application. pourtant il me donne une erreure.
"run time error 9" Subscrip ou of range...
que dois je faire.
encore merci
Bonjour samenvoegen,
| Mais mon excel est en anglais et je ne sais pas si
| il prend les function ecrit en francais.
Le code devrait s'exécuter normalement sur une version
Excel anglaise ou française
"Microsoft Activex Data Objects 2.0 Librairy a mon excel?
Pour ajouter cette bibliothèque, tu ouvres VBE (visual basic editor) -> Alt + F11
Dans cette fenêtre, barre des menus / outils / références / et dans la fenêtre
qui s'ouvre tu coches la bibliothèque mentionnnée dans la liste.
Pour ce qui est du reste, à toi de définir les variables selon ton application.
NomFeuille = "Feuil1" 'A déterminer
Chemin = "C:test" 'à déterminer
Comme la procédure extrait toutes les données du nom de la feuille que tu
indiquera pour tous les classeurs de ce répertoire, la procédure suppose
que le classeur "Consolitation" se trouve dans un autre répertoire et ce afin
de ne pas intégrer dans la compilation les données 2 fois.
Salutations!
"samenvoegen van sheets" <samenvoegenvansheets@discussions.microsoft.com> a écrit dans le message de news:
C3155D12-9CE0-4DED-A569-2467AD88684F@microsoft.com...
Bonjour michdenis,
merci pour ta reponse.
Le probleme est que je ne suis pas une pro d'excel, je suppose que je dois
copier ceci dans un macro. Mais mon excel est en anglais et je ne sais pas si
il prend les function ecrit en francais.
pourrais tu m'aider a traduire cette fonction en anglais?
supposons que:
1.mes documents ce trouve dans: C:MSLM testMars sheets for consolidation
2.mes documents se nomment tous "MARSPricingSheet" avec un numero derriere
3.la premiere feuille de chaque document est "lines"
Si j'ai bien compris je doit faire demarrer ce macro appartir d'un document
qui ne se trouve pas dans la meme farde mais comment dois ajouter "Microsoft
Activex Data Objects 2.0 Librairy a mon excel?
peux tu m'aider encore un peu?
merci bcp,
florence
Bonjour amenvoegen ,
Voici la procédure qui récupérera les données pour tous les
fichiers d'un même répertoire. Cela suppose que tous ces
fichiers possèdent une feuille ayant le même nom sur
laquelle se retrouve la même structure des données.
Pour adapter cette procédure à ton projet, tu dois définir :
A ) Le Chemin de ton répertoire
B ) Le nom de l'onglet de la feuille où sont les données
C ) Il te reste à écrire la requête pour extraire les données.
D ) Il est pris pour acquis que le classeur d'où sera exécuté
cette macro ne fait pas parti du répertoire visé... sinon
il faut modifier légèrement la macro.
Tu dois ajouter à ton fichier excel, la bibliothèque suivante :
"Microsoft Activex Data Objects 2.0 Librairy
Ceci a été testé avec Excel 97 et c'est OK
pour les autres versions -> adapter la méthode CopyFromRecordset
'-------------------------------------------
Sub MaRequêteAvecADO()
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
NomFeuille = "Feuil1" 'A déterminer
Chemin = "C:test" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil2")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
Rst.Open Requete, Conn, adOpenStatic, adLockOptimistic
Nb = Rst.RecordCount
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).Resize(Nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
Else
Rg.Resize(Nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
End If
File = Dir()
Rst.Close
Conn.Close
Loop
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'----------------------------------
Function TransposeSpecial2(ByRef Arr As Variant) As Variant
Dim A As Integer, B As Integer, Arr1() As Variant
Dim C As Integer, D As Integer
A = UBound(Arr, 1): B = UBound(Arr, 2)
ReDim Arr1(B, A)
For C = 0 To A
For D = 0 To B
Arr1(D, C) = Arr(C, D)
Next
Next
TransposeSpecial2 = (Arr1)
End Function
'-------------------------------------------
Salutations!
"samenvoegen van sheets" <samenvoegenvansheets@discussions.microsoft.com> a écrit dans le message de news:
9BA83B18-8DD7-4B76-A6C0-281B690244D4@microsoft.com...
Bonjour,
J'aimerais consolider des données ce trouvant sur 20 feuilles differentes
dans 20 documents excel (la feuille concerné etant toujours la premiere
feuille de chaque document). Les differentes feuilles on le meme lay-out mais
contiennes des collonnes similaires et differentes.
En utilisant la fonction "consolider" mon text n'apparait pas sur ma feuille
consolidé. Que dois je faire?
Il y a t'il moyen de travailles avec la fonction "recherchev" pour
rechercher les donner dans les differents documents? si, oui comment faire?
Il y a t'il une solutioàn a mon probleme ...
merci beaucoup!!
florence
| et quand j'appuie sur debug la ligne:
| With Worksheets("feuil2")
| est jaune.
As-tu dans ton classeur une feuille dont l'onglet est "Feuil2" ?
Sinon, donne un nom qui appartient à ton classeur...
Salutations!
"samenvoegen van sheets" a écrit dans le message de news:
Merci encore de bien vouloir m'aider,
J'ai donc ajouter "Microsoft Activex Data Objects 2.0 Librairy" et defini
les variable de l'application. pourtant il me donne une erreure.
"run time error 9" Subscrip ou of range...
que dois je faire.
encore merci
Bonjour samenvoegen,
| Mais mon excel est en anglais et je ne sais pas si
| il prend les function ecrit en francais.
Le code devrait s'exécuter normalement sur une version
Excel anglaise ou française
"Microsoft Activex Data Objects 2.0 Librairy a mon excel?
Pour ajouter cette bibliothèque, tu ouvres VBE (visual basic editor) -> Alt + F11
Dans cette fenêtre, barre des menus / outils / références / et dans la fenêtre
qui s'ouvre tu coches la bibliothèque mentionnnée dans la liste.
Pour ce qui est du reste, à toi de définir les variables selon ton application.
NomFeuille = "Feuil1" 'A déterminer
Chemin = "C:test" 'à déterminer
Comme la procédure extrait toutes les données du nom de la feuille que tu
indiquera pour tous les classeurs de ce répertoire, la procédure suppose
que le classeur "Consolitation" se trouve dans un autre répertoire et ce afin
de ne pas intégrer dans la compilation les données 2 fois.
Salutations!
"samenvoegen van sheets" a écrit dans le message de news:
Bonjour michdenis,
merci pour ta reponse.
Le probleme est que je ne suis pas une pro d'excel, je suppose que je dois
copier ceci dans un macro. Mais mon excel est en anglais et je ne sais pas si
il prend les function ecrit en francais.
pourrais tu m'aider a traduire cette fonction en anglais?
supposons que:
1.mes documents ce trouve dans: C:MSLM testMars sheets for consolidation
2.mes documents se nomment tous "MARSPricingSheet" avec un numero derriere
3.la premiere feuille de chaque document est "lines"
Si j'ai bien compris je doit faire demarrer ce macro appartir d'un document
qui ne se trouve pas dans la meme farde mais comment dois ajouter "Microsoft
Activex Data Objects 2.0 Librairy a mon excel?
peux tu m'aider encore un peu?
merci bcp,
florenceBonjour amenvoegen ,
Voici la procédure qui récupérera les données pour tous les
fichiers d'un même répertoire. Cela suppose que tous ces
fichiers possèdent une feuille ayant le même nom sur
laquelle se retrouve la même structure des données.
Pour adapter cette procédure à ton projet, tu dois définir :
A ) Le Chemin de ton répertoire
B ) Le nom de l'onglet de la feuille où sont les données
C ) Il te reste à écrire la requête pour extraire les données.
D ) Il est pris pour acquis que le classeur d'où sera exécuté
cette macro ne fait pas parti du répertoire visé... sinon
il faut modifier légèrement la macro.
Tu dois ajouter à ton fichier excel, la bibliothèque suivante :
"Microsoft Activex Data Objects 2.0 Librairy
Ceci a été testé avec Excel 97 et c'est OK
pour les autres versions -> adapter la méthode CopyFromRecordset
'-------------------------------------------
Sub MaRequêteAvecADO()
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
NomFeuille = "Feuil1" 'A déterminer
Chemin = "C:test" 'à déterminer
'La requête qui sera exécutée ' `a déterminer
Requete = "SELECT * From [" & NomFeuille & "$]"
'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
'Récupérer dans un tableau, la liste des
'fichiers excel du répertoire.
File = Dir(Chemin & "*.xls")
Do While File <> ""
'Défini la première cellule où seront copiées les
'données des requêtes ADO
With Worksheets("Feuil2")
If .Range("A1") = "" Then
Set Rg = .Range("A1")
Else
Set Rg = .Range("A" & .Range("A65356").End(xlUp).Row)(2)
Ok = 1
End If
End With
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & File & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
Rst.Open Requete, Conn, adOpenStatic, adLockOptimistic
Nb = Rst.RecordCount
'Copie les étiquettes du recordset vers Excel
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
Rg.Offset(1).Resize(Nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
Else
Rg.Resize(Nb, Rst.Fields.Count) = _
TransposeSpecial2(Rst.GetRows)
End If
File = Dir()
Rst.Close
Conn.Close
Loop
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'----------------------------------
Function TransposeSpecial2(ByRef Arr As Variant) As Variant
Dim A As Integer, B As Integer, Arr1() As Variant
Dim C As Integer, D As Integer
A = UBound(Arr, 1): B = UBound(Arr, 2)
ReDim Arr1(B, A)
For C = 0 To A
For D = 0 To B
Arr1(D, C) = Arr(C, D)
Next
Next
TransposeSpecial2 = (Arr1)
End Function
'-------------------------------------------
Salutations!
"samenvoegen van sheets" a écrit dans le message de news:
Bonjour,
J'aimerais consolider des données ce trouvant sur 20 feuilles differentes
dans 20 documents excel (la feuille concerné etant toujours la premiere
feuille de chaque document). Les differentes feuilles on le meme lay-out mais
contiennes des collonnes similaires et differentes.
En utilisant la fonction "consolider" mon text n'apparait pas sur ma feuille
consolidé. Que dois je faire?
Il y a t'il moyen de travailles avec la fonction "recherchev" pour
rechercher les donner dans les differents documents? si, oui comment faire?
Il y a t'il une solutioàn a mon probleme ...
merci beaucoup!!
florence