Hello à tous !
Je dois écrire une macro qui récupère dans une feuille d'un même classeur,
les données situées sur la première feuilles d'une dizaine de classeur.
Tous les classeurs ont la même structure, y a pas de problème de doublons,
c'est relativement simple. Je fais une macro qui boucle sur tous les
classeurs, les ouvre un par un, copie, ferme et colle.
N'y aurait-il pas un moyen plus élégant de récupérer ces données sans
ouvrir les classeurs...
Avec Word (ben oui, c'est plus mon domaine...) on a la méthode InsertFile,
il n'y a pas quelque chose d'équivalent avec Excel ?
Merci par avance ;)
Circé
http://faqword.free.fr
Hello à tous !
Je dois écrire une macro qui récupère dans une feuille d'un même classeur,
les données situées sur la première feuilles d'une dizaine de classeur.
Tous les classeurs ont la même structure, y a pas de problème de doublons,
c'est relativement simple. Je fais une macro qui boucle sur tous les
classeurs, les ouvre un par un, copie, ferme et colle.
N'y aurait-il pas un moyen plus élégant de récupérer ces données sans
ouvrir les classeurs...
Avec Word (ben oui, c'est plus mon domaine...) on a la méthode InsertFile,
il n'y a pas quelque chose d'équivalent avec Excel ?
Merci par avance ;)
Circé
http://faqword.free.fr
Hello à tous !
Je dois écrire une macro qui récupère dans une feuille d'un même classeur,
les données situées sur la première feuilles d'une dizaine de classeur.
Tous les classeurs ont la même structure, y a pas de problème de doublons,
c'est relativement simple. Je fais une macro qui boucle sur tous les
classeurs, les ouvre un par un, copie, ferme et colle.
N'y aurait-il pas un moyen plus élégant de récupérer ces données sans
ouvrir les classeurs...
Avec Word (ben oui, c'est plus mon domaine...) on a la méthode InsertFile,
il n'y a pas quelque chose d'équivalent avec Excel ?
Merci par avance ;)
Circé
http://faqword.free.fr
Hello à tous !
Je dois écrire une macro qui récupère dans une feuille d'un même
classeur, les données situées sur la première feuilles d'une dizain e de
classeur.
Tous les classeurs ont la même structure, y a pas de problème de
doublons, c'est relativement simple. Je fais une macro qui boucle sur
tous les classeurs, les ouvre un par un, copie, ferme et colle.
N'y aurait-il pas un moyen plus élégant de récupérer ces donné es sans
ouvrir les classeurs...
Avec Word (ben oui, c'est plus mon domaine...) on a la méthode
InsertFile, il n'y a pas quelque chose d'équivalent avec Excel ?
Merci par avance ;)
Circéhttp://faqword.free.fr
Hello à tous !
Je dois écrire une macro qui récupère dans une feuille d'un même
classeur, les données situées sur la première feuilles d'une dizain e de
classeur.
Tous les classeurs ont la même structure, y a pas de problème de
doublons, c'est relativement simple. Je fais une macro qui boucle sur
tous les classeurs, les ouvre un par un, copie, ferme et colle.
N'y aurait-il pas un moyen plus élégant de récupérer ces donné es sans
ouvrir les classeurs...
Avec Word (ben oui, c'est plus mon domaine...) on a la méthode
InsertFile, il n'y a pas quelque chose d'équivalent avec Excel ?
Merci par avance ;)
Circéhttp://faqword.free.fr
Hello à tous !
Je dois écrire une macro qui récupère dans une feuille d'un même
classeur, les données situées sur la première feuilles d'une dizain e de
classeur.
Tous les classeurs ont la même structure, y a pas de problème de
doublons, c'est relativement simple. Je fais une macro qui boucle sur
tous les classeurs, les ouvre un par un, copie, ferme et colle.
N'y aurait-il pas un moyen plus élégant de récupérer ces donné es sans
ouvrir les classeurs...
Avec Word (ben oui, c'est plus mon domaine...) on a la méthode
InsertFile, il n'y a pas quelque chose d'équivalent avec Excel ?
Merci par avance ;)
Circéhttp://faqword.free.fr
Toutes les feuilles de données sont réputées avoir
une ligne d'étiquette définissant les champs de la table.
Ne pas oublier de déclarer les bibliothèques mentionnées
dans la procédure : "Extraire_Data_First_Excel_Sheet"
'------------------------------------------
Sub Test()
'Appel d'une procédure ayant 2 paramêtres
'A ) Répertoire à scanner
'Ne pas oublier le "" à la fin comme dans "c:AAA"
'B ) 'L'adresse de la première cellule du coin supérieur
'gauche où seront copiées les données recueillies
'Différente syntaxe possible pour appeler la procédure :
'Exemple de la plus longue à la plus courte :
'La plus longue : ThisWorkbook.Worksheets("Feuil2").Range("G10")
Extraire_Data_First_Excel_Sheet "c:AAA", _
ThisWorkbook.Worksheets("Feuil2").Range("G10")
'OU
'La plus courte : Range("G10")
Extraire_Data_First_Excel_Sheet "c:AAA", Range("G10")
End Sub
'------------------------------------------
Sub Extraire_Data_First_Excel_Sheet(Chemin As String, Rg As Range)
'Nécessite l 'ajoute de la bibliothèque suivante :
'"Microsoft Activex Data Object 2.x librairy"
' ET
'"Microsoft Dao 3.6 Objects librairy"
'Extrait les données de plusieurs classeurs d'un même
'répertoire en prenant pour acquis que les données ont
'la même structure. Le nom de la première feuille est
'obtenue par la fonction "FirstExcelSheetName"
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String
Dim file As String, C As Integer, Ok As Integer
Dim ModeCalcul As String
'Extrait le premier fichier du répertoire
file = Dir(Chemin & "*.xls")
ModeCalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
Do While file <> ""
'Nom de la feuille où les données seront copiées
'dans le classeur où la macro est écrite :
'Détermine la première cellule où seront copiées
'les données des requêtes des classeurs
If Rg(1, 1) = "" Then
Set Rg = Rg(1, 1)
Else
Set Rg = Rg.EntireColumn.Find(What:="*", LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Offset(1)
Ok = 1
End If
'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & file & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
'détermine le nom de la première feuille du classeur
NomFeuille = FirstExcelSheetName(Chemin & file)
'Détermine la requête à être exécuté
Requete = "SELECT * From [" & NomFeuille & "]"
'Exécution de la requête
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie le nom des champs du recordset vers Excel
'dans le cas du premier classeur seulement
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
'Copie le recordset vers Excel
Rg.Offset(1).CopyFromRecordset Rst
Else
'Copie le recordset vers Excel
Rg.CopyFromRecordset Rst
End If
'Passe au classeur suivant
file = Dir()
'Ferme le recordset et la connection
Rst.Close: Conn.Close
Loop
Application.Calculation = ModeCalcul
Application.EnableEvents = True
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'------------------------------------------
Function FirstExcelSheetName(Fichier As String)
Dim XlDb As DAO.Database
Dim TbL As DAO.TableDef
Set XlDb = OpenDatabase(Fichier, False, True, "Excel 8.0;")
FirstExcelSheetName = XlDb.TableDefs(0).Name
XlDb.Close: Set XlDb = Nothing
End Function
'------------------------------------------
"Circé" a écrit dans le message de news:
Hello à tous !
Je dois écrire une macro qui récupère dans une feuille d'un même
classeur, les données situées sur la première feuilles d'une dizaine de
classeur.
Tous les classeurs ont la même structure, y a pas de problème de
doublons, c'est relativement simple. Je fais une macro qui boucle sur
tous les classeurs, les ouvre un par un, copie, ferme et colle.
N'y aurait-il pas un moyen plus élégant de récupérer ces données sans
ouvrir les classeurs...
Avec Word (ben oui, c'est plus mon domaine...) on a la méthode
InsertFile, il n'y a pas quelque chose d'équivalent avec Excel ?
Merci par avance ;)
Circé
http://faqword.free.fr
Toutes les feuilles de données sont réputées avoir
une ligne d'étiquette définissant les champs de la table.
Ne pas oublier de déclarer les bibliothèques mentionnées
dans la procédure : "Extraire_Data_First_Excel_Sheet"
'------------------------------------------
Sub Test()
'Appel d'une procédure ayant 2 paramêtres
'A ) Répertoire à scanner
'Ne pas oublier le "" à la fin comme dans "c:AAA"
'B ) 'L'adresse de la première cellule du coin supérieur
'gauche où seront copiées les données recueillies
'Différente syntaxe possible pour appeler la procédure :
'Exemple de la plus longue à la plus courte :
'La plus longue : ThisWorkbook.Worksheets("Feuil2").Range("G10")
Extraire_Data_First_Excel_Sheet "c:AAA", _
ThisWorkbook.Worksheets("Feuil2").Range("G10")
'OU
'La plus courte : Range("G10")
Extraire_Data_First_Excel_Sheet "c:AAA", Range("G10")
End Sub
'------------------------------------------
Sub Extraire_Data_First_Excel_Sheet(Chemin As String, Rg As Range)
'Nécessite l 'ajoute de la bibliothèque suivante :
'"Microsoft Activex Data Object 2.x librairy"
' ET
'"Microsoft Dao 3.6 Objects librairy"
'Extrait les données de plusieurs classeurs d'un même
'répertoire en prenant pour acquis que les données ont
'la même structure. Le nom de la première feuille est
'obtenue par la fonction "FirstExcelSheetName"
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String
Dim file As String, C As Integer, Ok As Integer
Dim ModeCalcul As String
'Extrait le premier fichier du répertoire
file = Dir(Chemin & "*.xls")
ModeCalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
Do While file <> ""
'Nom de la feuille où les données seront copiées
'dans le classeur où la macro est écrite :
'Détermine la première cellule où seront copiées
'les données des requêtes des classeurs
If Rg(1, 1) = "" Then
Set Rg = Rg(1, 1)
Else
Set Rg = Rg.EntireColumn.Find(What:="*", LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Offset(1)
Ok = 1
End If
'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & file & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
'détermine le nom de la première feuille du classeur
NomFeuille = FirstExcelSheetName(Chemin & file)
'Détermine la requête à être exécuté
Requete = "SELECT * From [" & NomFeuille & "]"
'Exécution de la requête
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie le nom des champs du recordset vers Excel
'dans le cas du premier classeur seulement
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
'Copie le recordset vers Excel
Rg.Offset(1).CopyFromRecordset Rst
Else
'Copie le recordset vers Excel
Rg.CopyFromRecordset Rst
End If
'Passe au classeur suivant
file = Dir()
'Ferme le recordset et la connection
Rst.Close: Conn.Close
Loop
Application.Calculation = ModeCalcul
Application.EnableEvents = True
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'------------------------------------------
Function FirstExcelSheetName(Fichier As String)
Dim XlDb As DAO.Database
Dim TbL As DAO.TableDef
Set XlDb = OpenDatabase(Fichier, False, True, "Excel 8.0;")
FirstExcelSheetName = XlDb.TableDefs(0).Name
XlDb.Close: Set XlDb = Nothing
End Function
'------------------------------------------
"Circé" <circe@aea.gr> a écrit dans le message de news:
mn.bd717d7afe6871a5.54897@aea.gr... Hello à tous !
Je dois écrire une macro qui récupère dans une feuille d'un même
classeur, les données situées sur la première feuilles d'une dizaine de
classeur.
Tous les classeurs ont la même structure, y a pas de problème de
doublons, c'est relativement simple. Je fais une macro qui boucle sur
tous les classeurs, les ouvre un par un, copie, ferme et colle.
N'y aurait-il pas un moyen plus élégant de récupérer ces données sans
ouvrir les classeurs...
Avec Word (ben oui, c'est plus mon domaine...) on a la méthode
InsertFile, il n'y a pas quelque chose d'équivalent avec Excel ?
Merci par avance ;)
Circé
http://faqword.free.fr
Toutes les feuilles de données sont réputées avoir
une ligne d'étiquette définissant les champs de la table.
Ne pas oublier de déclarer les bibliothèques mentionnées
dans la procédure : "Extraire_Data_First_Excel_Sheet"
'------------------------------------------
Sub Test()
'Appel d'une procédure ayant 2 paramêtres
'A ) Répertoire à scanner
'Ne pas oublier le "" à la fin comme dans "c:AAA"
'B ) 'L'adresse de la première cellule du coin supérieur
'gauche où seront copiées les données recueillies
'Différente syntaxe possible pour appeler la procédure :
'Exemple de la plus longue à la plus courte :
'La plus longue : ThisWorkbook.Worksheets("Feuil2").Range("G10")
Extraire_Data_First_Excel_Sheet "c:AAA", _
ThisWorkbook.Worksheets("Feuil2").Range("G10")
'OU
'La plus courte : Range("G10")
Extraire_Data_First_Excel_Sheet "c:AAA", Range("G10")
End Sub
'------------------------------------------
Sub Extraire_Data_First_Excel_Sheet(Chemin As String, Rg As Range)
'Nécessite l 'ajoute de la bibliothèque suivante :
'"Microsoft Activex Data Object 2.x librairy"
' ET
'"Microsoft Dao 3.6 Objects librairy"
'Extrait les données de plusieurs classeurs d'un même
'répertoire en prenant pour acquis que les données ont
'la même structure. Le nom de la première feuille est
'obtenue par la fonction "FirstExcelSheetName"
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String
Dim file As String, C As Integer, Ok As Integer
Dim ModeCalcul As String
'Extrait le premier fichier du répertoire
file = Dir(Chemin & "*.xls")
ModeCalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
Do While file <> ""
'Nom de la feuille où les données seront copiées
'dans le classeur où la macro est écrite :
'Détermine la première cellule où seront copiées
'les données des requêtes des classeurs
If Rg(1, 1) = "" Then
Set Rg = Rg(1, 1)
Else
Set Rg = Rg.EntireColumn.Find(What:="*", LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Offset(1)
Ok = 1
End If
'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & file & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
'détermine le nom de la première feuille du classeur
NomFeuille = FirstExcelSheetName(Chemin & file)
'Détermine la requête à être exécuté
Requete = "SELECT * From [" & NomFeuille & "]"
'Exécution de la requête
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie le nom des champs du recordset vers Excel
'dans le cas du premier classeur seulement
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
'Copie le recordset vers Excel
Rg.Offset(1).CopyFromRecordset Rst
Else
'Copie le recordset vers Excel
Rg.CopyFromRecordset Rst
End If
'Passe au classeur suivant
file = Dir()
'Ferme le recordset et la connection
Rst.Close: Conn.Close
Loop
Application.Calculation = ModeCalcul
Application.EnableEvents = True
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'------------------------------------------
Function FirstExcelSheetName(Fichier As String)
Dim XlDb As DAO.Database
Dim TbL As DAO.TableDef
Set XlDb = OpenDatabase(Fichier, False, True, "Excel 8.0;")
FirstExcelSheetName = XlDb.TableDefs(0).Name
XlDb.Close: Set XlDb = Nothing
End Function
'------------------------------------------
"Circé" a écrit dans le message de news:
Hello à tous !
Je dois écrire une macro qui récupère dans une feuille d'un même
classeur, les données situées sur la première feuilles d'une dizaine de
classeur.
Tous les classeurs ont la même structure, y a pas de problème de
doublons, c'est relativement simple. Je fais une macro qui boucle sur
tous les classeurs, les ouvre un par un, copie, ferme et colle.
N'y aurait-il pas un moyen plus élégant de récupérer ces données sans
ouvrir les classeurs...
Avec Word (ben oui, c'est plus mon domaine...) on a la méthode
InsertFile, il n'y a pas quelque chose d'équivalent avec Excel ?
Merci par avance ;)
Circé
http://faqword.free.fr
Bonjour,
http://boisgontierjacques.free.fr/pages_site/GestionOnglets.htm#OngletsClasseursRepertoire
JB
http://boisgontierjacques.free.fr
On 23 oct, 23:13, Circé wrote:Hello à tous !
Je dois écrire une macro qui récupère dans une feuille d'un même
classeur, les données situées sur la première feuilles d'une dizaine de
classeur.
Tous les classeurs ont la même structure, y a pas de problème de
doublons, c'est relativement simple. Je fais une macro qui boucle sur
tous les classeurs, les ouvre un par un, copie, ferme et colle.
N'y aurait-il pas un moyen plus élégant de récupérer ces données sans
ouvrir les classeurs...
Avec Word (ben oui, c'est plus mon domaine...) on a la méthode
InsertFile, il n'y a pas quelque chose d'équivalent avec Excel ?
Merci par avance ;)
Circéhttp://faqword.free.fr
Bonjour,
http://boisgontierjacques.free.fr/pages_site/GestionOnglets.htm#OngletsClasseursRepertoire
JB
http://boisgontierjacques.free.fr
On 23 oct, 23:13, Circé <ci...@aea.gr> wrote:
Hello à tous !
Je dois écrire une macro qui récupère dans une feuille d'un même
classeur, les données situées sur la première feuilles d'une dizaine de
classeur.
Tous les classeurs ont la même structure, y a pas de problème de
doublons, c'est relativement simple. Je fais une macro qui boucle sur
tous les classeurs, les ouvre un par un, copie, ferme et colle.
N'y aurait-il pas un moyen plus élégant de récupérer ces données sans
ouvrir les classeurs...
Avec Word (ben oui, c'est plus mon domaine...) on a la méthode
InsertFile, il n'y a pas quelque chose d'équivalent avec Excel ?
Merci par avance ;)
Circéhttp://faqword.free.fr
Bonjour,
http://boisgontierjacques.free.fr/pages_site/GestionOnglets.htm#OngletsClasseursRepertoire
JB
http://boisgontierjacques.free.fr
On 23 oct, 23:13, Circé wrote:Hello à tous !
Je dois écrire une macro qui récupère dans une feuille d'un même
classeur, les données situées sur la première feuilles d'une dizaine de
classeur.
Tous les classeurs ont la même structure, y a pas de problème de
doublons, c'est relativement simple. Je fais une macro qui boucle sur
tous les classeurs, les ouvre un par un, copie, ferme et colle.
N'y aurait-il pas un moyen plus élégant de récupérer ces données sans
ouvrir les classeurs...
Avec Word (ben oui, c'est plus mon domaine...) on a la méthode
InsertFile, il n'y a pas quelque chose d'équivalent avec Excel ?
Merci par avance ;)
Circéhttp://faqword.free.fr
Bonjour
Un grand merci à tous les deux + Frédéric + Robert !
J'ai repris presque texto la macro de MichDenis, Ça fonctionne nickel,
nickel...
De plus, j'ai découvert plein de choses à ce sujet sur le site de Frédéric
! Je suis épatée, ça dépasse mes espérances !!! :D)))
A bientôt, je crois que je vais avoir d'autres questions... ;))
Circé
http://faqword.free.fr
MichDenis a utilisé son clavier pour écrire :Toutes les feuilles de données sont réputées avoir
une ligne d'étiquette définissant les champs de la table.
Ne pas oublier de déclarer les bibliothèques mentionnées
dans la procédure : "Extraire_Data_First_Excel_Sheet"
'------------------------------------------
Sub Test()
'Appel d'une procédure ayant 2 paramêtres
'A ) Répertoire à scanner
'Ne pas oublier le "" à la fin comme dans "c:AAA"
'B ) 'L'adresse de la première cellule du coin supérieur
'gauche où seront copiées les données recueillies
'Différente syntaxe possible pour appeler la procédure :
'Exemple de la plus longue à la plus courte :
'La plus longue : ThisWorkbook.Worksheets("Feuil2").Range("G10")
Extraire_Data_First_Excel_Sheet "c:AAA", _
ThisWorkbook.Worksheets("Feuil2").Range("G10")
'OU
'La plus courte : Range("G10")
Extraire_Data_First_Excel_Sheet "c:AAA", Range("G10")
End Sub
'------------------------------------------
Sub Extraire_Data_First_Excel_Sheet(Chemin As String, Rg As Range)
'Nécessite l 'ajoute de la bibliothèque suivante :
'"Microsoft Activex Data Object 2.x librairy"
' ET
'"Microsoft Dao 3.6 Objects librairy"
'Extrait les données de plusieurs classeurs d'un même
'répertoire en prenant pour acquis que les données ont
'la même structure. Le nom de la première feuille est
'obtenue par la fonction "FirstExcelSheetName"
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String
Dim file As String, C As Integer, Ok As Integer
Dim ModeCalcul As String
'Extrait le premier fichier du répertoire
file = Dir(Chemin & "*.xls")
ModeCalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
Do While file <> ""
'Nom de la feuille où les données seront copiées
'dans le classeur où la macro est écrite :
'Détermine la première cellule où seront copiées
'les données des requêtes des classeurs
If Rg(1, 1) = "" Then
Set Rg = Rg(1, 1)
Else
Set Rg = Rg.EntireColumn.Find(What:="*", LookIn:=xlFormulas, _
SearchOrder:=xlByColumns,
SearchDirection:=xlPrevious).Offset(1)
Ok = 1
End If
'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & file & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
'détermine le nom de la première feuille du classeur
NomFeuille = FirstExcelSheetName(Chemin & file)
'Détermine la requête à être exécuté
Requete = "SELECT * From [" & NomFeuille & "]"
'Exécution de la requête
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie le nom des champs du recordset vers Excel
'dans le cas du premier classeur seulement
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
'Copie le recordset vers Excel
Rg.Offset(1).CopyFromRecordset Rst
Else
'Copie le recordset vers Excel
Rg.CopyFromRecordset Rst
End If
'Passe au classeur suivant
file = Dir()
'Ferme le recordset et la connection
Rst.Close: Conn.Close
Loop
Application.Calculation = ModeCalcul
Application.EnableEvents = True
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'------------------------------------------
Function FirstExcelSheetName(Fichier As String)
Dim XlDb As DAO.Database
Dim TbL As DAO.TableDef
Set XlDb = OpenDatabase(Fichier, False, True, "Excel 8.0;")
FirstExcelSheetName = XlDb.TableDefs(0).Name
XlDb.Close: Set XlDb = Nothing
End Function
'------------------------------------------
"Circé" a écrit dans le message de news:
Hello à tous !
Je dois écrire une macro qui récupère dans une feuille d'un même
classeur, les données situées sur la première feuilles d'une dizaine de
classeur.
Tous les classeurs ont la même structure, y a pas de problème de
doublons, c'est relativement simple. Je fais une macro qui boucle sur
tous les classeurs, les ouvre un par un, copie, ferme et colle.
N'y aurait-il pas un moyen plus élégant de récupérer ces données sans
ouvrir les classeurs...
Avec Word (ben oui, c'est plus mon domaine...) on a la méthode
InsertFile, il n'y a pas quelque chose d'équivalent avec Excel ?
Merci par avance ;)
Circé
http://faqword.free.fr
Bonjour
Un grand merci à tous les deux + Frédéric + Robert !
J'ai repris presque texto la macro de MichDenis, Ça fonctionne nickel,
nickel...
De plus, j'ai découvert plein de choses à ce sujet sur le site de Frédéric
! Je suis épatée, ça dépasse mes espérances !!! :D)))
A bientôt, je crois que je vais avoir d'autres questions... ;))
Circé
http://faqword.free.fr
MichDenis a utilisé son clavier pour écrire :
Toutes les feuilles de données sont réputées avoir
une ligne d'étiquette définissant les champs de la table.
Ne pas oublier de déclarer les bibliothèques mentionnées
dans la procédure : "Extraire_Data_First_Excel_Sheet"
'------------------------------------------
Sub Test()
'Appel d'une procédure ayant 2 paramêtres
'A ) Répertoire à scanner
'Ne pas oublier le "" à la fin comme dans "c:AAA"
'B ) 'L'adresse de la première cellule du coin supérieur
'gauche où seront copiées les données recueillies
'Différente syntaxe possible pour appeler la procédure :
'Exemple de la plus longue à la plus courte :
'La plus longue : ThisWorkbook.Worksheets("Feuil2").Range("G10")
Extraire_Data_First_Excel_Sheet "c:AAA", _
ThisWorkbook.Worksheets("Feuil2").Range("G10")
'OU
'La plus courte : Range("G10")
Extraire_Data_First_Excel_Sheet "c:AAA", Range("G10")
End Sub
'------------------------------------------
Sub Extraire_Data_First_Excel_Sheet(Chemin As String, Rg As Range)
'Nécessite l 'ajoute de la bibliothèque suivante :
'"Microsoft Activex Data Object 2.x librairy"
' ET
'"Microsoft Dao 3.6 Objects librairy"
'Extrait les données de plusieurs classeurs d'un même
'répertoire en prenant pour acquis que les données ont
'la même structure. Le nom de la première feuille est
'obtenue par la fonction "FirstExcelSheetName"
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String
Dim file As String, C As Integer, Ok As Integer
Dim ModeCalcul As String
'Extrait le premier fichier du répertoire
file = Dir(Chemin & "*.xls")
ModeCalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
Do While file <> ""
'Nom de la feuille où les données seront copiées
'dans le classeur où la macro est écrite :
'Détermine la première cellule où seront copiées
'les données des requêtes des classeurs
If Rg(1, 1) = "" Then
Set Rg = Rg(1, 1)
Else
Set Rg = Rg.EntireColumn.Find(What:="*", LookIn:=xlFormulas, _
SearchOrder:=xlByColumns,
SearchDirection:=xlPrevious).Offset(1)
Ok = 1
End If
'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & file & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
'détermine le nom de la première feuille du classeur
NomFeuille = FirstExcelSheetName(Chemin & file)
'Détermine la requête à être exécuté
Requete = "SELECT * From [" & NomFeuille & "]"
'Exécution de la requête
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie le nom des champs du recordset vers Excel
'dans le cas du premier classeur seulement
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
'Copie le recordset vers Excel
Rg.Offset(1).CopyFromRecordset Rst
Else
'Copie le recordset vers Excel
Rg.CopyFromRecordset Rst
End If
'Passe au classeur suivant
file = Dir()
'Ferme le recordset et la connection
Rst.Close: Conn.Close
Loop
Application.Calculation = ModeCalcul
Application.EnableEvents = True
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'------------------------------------------
Function FirstExcelSheetName(Fichier As String)
Dim XlDb As DAO.Database
Dim TbL As DAO.TableDef
Set XlDb = OpenDatabase(Fichier, False, True, "Excel 8.0;")
FirstExcelSheetName = XlDb.TableDefs(0).Name
XlDb.Close: Set XlDb = Nothing
End Function
'------------------------------------------
"Circé" <circe@aea.gr> a écrit dans le message de news:
mn.bd717d7afe6871a5.54897@aea.gr... Hello à tous !
Je dois écrire une macro qui récupère dans une feuille d'un même
classeur, les données situées sur la première feuilles d'une dizaine de
classeur.
Tous les classeurs ont la même structure, y a pas de problème de
doublons, c'est relativement simple. Je fais une macro qui boucle sur
tous les classeurs, les ouvre un par un, copie, ferme et colle.
N'y aurait-il pas un moyen plus élégant de récupérer ces données sans
ouvrir les classeurs...
Avec Word (ben oui, c'est plus mon domaine...) on a la méthode
InsertFile, il n'y a pas quelque chose d'équivalent avec Excel ?
Merci par avance ;)
Circé
http://faqword.free.fr
Bonjour
Un grand merci à tous les deux + Frédéric + Robert !
J'ai repris presque texto la macro de MichDenis, Ça fonctionne nickel,
nickel...
De plus, j'ai découvert plein de choses à ce sujet sur le site de Frédéric
! Je suis épatée, ça dépasse mes espérances !!! :D)))
A bientôt, je crois que je vais avoir d'autres questions... ;))
Circé
http://faqword.free.fr
MichDenis a utilisé son clavier pour écrire :Toutes les feuilles de données sont réputées avoir
une ligne d'étiquette définissant les champs de la table.
Ne pas oublier de déclarer les bibliothèques mentionnées
dans la procédure : "Extraire_Data_First_Excel_Sheet"
'------------------------------------------
Sub Test()
'Appel d'une procédure ayant 2 paramêtres
'A ) Répertoire à scanner
'Ne pas oublier le "" à la fin comme dans "c:AAA"
'B ) 'L'adresse de la première cellule du coin supérieur
'gauche où seront copiées les données recueillies
'Différente syntaxe possible pour appeler la procédure :
'Exemple de la plus longue à la plus courte :
'La plus longue : ThisWorkbook.Worksheets("Feuil2").Range("G10")
Extraire_Data_First_Excel_Sheet "c:AAA", _
ThisWorkbook.Worksheets("Feuil2").Range("G10")
'OU
'La plus courte : Range("G10")
Extraire_Data_First_Excel_Sheet "c:AAA", Range("G10")
End Sub
'------------------------------------------
Sub Extraire_Data_First_Excel_Sheet(Chemin As String, Rg As Range)
'Nécessite l 'ajoute de la bibliothèque suivante :
'"Microsoft Activex Data Object 2.x librairy"
' ET
'"Microsoft Dao 3.6 Objects librairy"
'Extrait les données de plusieurs classeurs d'un même
'répertoire en prenant pour acquis que les données ont
'la même structure. Le nom de la première feuille est
'obtenue par la fonction "FirstExcelSheetName"
Dim Conn As ADODB.Connection, Rst As New ADODB.Recordset
Dim Requete As String, NomFeuille As String
Dim file As String, C As Integer, Ok As Integer
Dim ModeCalcul As String
'Extrait le premier fichier du répertoire
file = Dir(Chemin & "*.xls")
ModeCalcul = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
Do While file <> ""
'Nom de la feuille où les données seront copiées
'dans le classeur où la macro est écrite :
'Détermine la première cellule où seront copiées
'les données des requêtes des classeurs
If Rg(1, 1) = "" Then
Set Rg = Rg(1, 1)
Else
Set Rg = Rg.EntireColumn.Find(What:="*", LookIn:=xlFormulas, _
SearchOrder:=xlByColumns,
SearchDirection:=xlPrevious).Offset(1)
Ok = 1
End If
'établir la connection avec le fichier...
Set Conn = New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Chemin & file & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
'détermine le nom de la première feuille du classeur
NomFeuille = FirstExcelSheetName(Chemin & file)
'Détermine la requête à être exécuté
Requete = "SELECT * From [" & NomFeuille & "]"
'Exécution de la requête
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
'Copie le nom des champs du recordset vers Excel
'dans le cas du premier classeur seulement
If Ok <> 1 Then
Do
Rg.Offset(, C) = Rst.Fields(C).Name
C = C + 1
x = x + 1
Loop Until x = Rst.Fields.Count
'Copie le recordset vers Excel
Rg.Offset(1).CopyFromRecordset Rst
Else
'Copie le recordset vers Excel
Rg.CopyFromRecordset Rst
End If
'Passe au classeur suivant
file = Dir()
'Ferme le recordset et la connection
Rst.Close: Conn.Close
Loop
Application.Calculation = ModeCalcul
Application.EnableEvents = True
Set Rst = Nothing: Set Conn = Nothing
Set Rg = Nothing
End Sub
'------------------------------------------
Function FirstExcelSheetName(Fichier As String)
Dim XlDb As DAO.Database
Dim TbL As DAO.TableDef
Set XlDb = OpenDatabase(Fichier, False, True, "Excel 8.0;")
FirstExcelSheetName = XlDb.TableDefs(0).Name
XlDb.Close: Set XlDb = Nothing
End Function
'------------------------------------------
"Circé" a écrit dans le message de news:
Hello à tous !
Je dois écrire une macro qui récupère dans une feuille d'un même
classeur, les données situées sur la première feuilles d'une dizaine de
classeur.
Tous les classeurs ont la même structure, y a pas de problème de
doublons, c'est relativement simple. Je fais une macro qui boucle sur
tous les classeurs, les ouvre un par un, copie, ferme et colle.
N'y aurait-il pas un moyen plus élégant de récupérer ces données sans
ouvrir les classeurs...
Avec Word (ben oui, c'est plus mon domaine...) on a la méthode
InsertFile, il n'y a pas quelque chose d'équivalent avec Excel ?
Merci par avance ;)
Circé
http://faqword.free.fr
Hello à tous !
Je dois écrire une macro qui récupère dans une feuille
d'un même
classeur, les données situées sur la première feuilles
d'une dizaine de
classeur.
Tous les classeurs ont la même structure, y a pas de problème de
doublons, c'est relativement simple. Je fais une macro qui boucle sur
tous les classeurs, les ouvre un par un, copie, ferme et colle.
N'y aurait-il pas un moyen plus élégant de
récupérer ces données sans
ouvrir les classeurs...
Avec Word (ben oui, c'est plus mon domaine...) on a la méthode
InsertFile, il n'y a pas quelque chose d'équivalent avec Excel ?
Merci par avance ;)
Circé
http://faqword.free.fr
Hello à tous !
Je dois écrire une macro qui récupère dans une feuille
d'un même
classeur, les données situées sur la première feuilles
d'une dizaine de
classeur.
Tous les classeurs ont la même structure, y a pas de problème de
doublons, c'est relativement simple. Je fais une macro qui boucle sur
tous les classeurs, les ouvre un par un, copie, ferme et colle.
N'y aurait-il pas un moyen plus élégant de
récupérer ces données sans
ouvrir les classeurs...
Avec Word (ben oui, c'est plus mon domaine...) on a la méthode
InsertFile, il n'y a pas quelque chose d'équivalent avec Excel ?
Merci par avance ;)
Circé
http://faqword.free.fr
Hello à tous !
Je dois écrire une macro qui récupère dans une feuille
d'un même
classeur, les données situées sur la première feuilles
d'une dizaine de
classeur.
Tous les classeurs ont la même structure, y a pas de problème de
doublons, c'est relativement simple. Je fais une macro qui boucle sur
tous les classeurs, les ouvre un par un, copie, ferme et colle.
N'y aurait-il pas un moyen plus élégant de
récupérer ces données sans
ouvrir les classeurs...
Avec Word (ben oui, c'est plus mon domaine...) on a la méthode
InsertFile, il n'y a pas quelque chose d'équivalent avec Excel ?
Merci par avance ;)
Circé
http://faqword.free.fr