Bonjour à toutes et tous,
J'ai un répertoire avec environ 10 fichiers.
A partir d'un fichier ouvert (macro - bouton) issu d'un autre
répertoire, je voudrais aller rechercher la même zone "Range
("A8:A100")" dans tous les fichiers du répertoire pour les copier dans
mon fichier en cours.
J'ai réussi à lister tous les fichiers du répertoire mais e nsuite, je
m'y perd un peu avec "For each".
Merci d'avance pour vos idées.
Julie
Bonjour à toutes et tous,
J'ai un répertoire avec environ 10 fichiers.
A partir d'un fichier ouvert (macro - bouton) issu d'un autre
répertoire, je voudrais aller rechercher la même zone "Range
("A8:A100")" dans tous les fichiers du répertoire pour les copier dans
mon fichier en cours.
J'ai réussi à lister tous les fichiers du répertoire mais e nsuite, je
m'y perd un peu avec "For each".
Merci d'avance pour vos idées.
Julie
Bonjour à toutes et tous,
J'ai un répertoire avec environ 10 fichiers.
A partir d'un fichier ouvert (macro - bouton) issu d'un autre
répertoire, je voudrais aller rechercher la même zone "Range
("A8:A100")" dans tous les fichiers du répertoire pour les copier dans
mon fichier en cours.
J'ai réussi à lister tous les fichiers du répertoire mais e nsuite, je
m'y perd un peu avec "For each".
Merci d'avance pour vos idées.
Julie
Bonjour à toutes et tous,
J'ai un répertoire avec environ 10 fichiers.
A partir d'un fichier ouvert (macro - bouton) issu d'un autre
répertoire, je voudrais aller rechercher la même zone "Range
("A8:A100")" dans tous les fichiers du répertoire pour les copier dans
mon fichier en cours.
J'ai réussi à lister tous les fichiers du répertoire mais ensuite,
je m'y perd un peu avec "For each".
Merci d'avance pour vos idées.
Julie
Bonjour à toutes et tous,
J'ai un répertoire avec environ 10 fichiers.
A partir d'un fichier ouvert (macro - bouton) issu d'un autre
répertoire, je voudrais aller rechercher la même zone "Range
("A8:A100")" dans tous les fichiers du répertoire pour les copier dans
mon fichier en cours.
J'ai réussi à lister tous les fichiers du répertoire mais ensuite,
je m'y perd un peu avec "For each".
Merci d'avance pour vos idées.
Julie
Bonjour à toutes et tous,
J'ai un répertoire avec environ 10 fichiers.
A partir d'un fichier ouvert (macro - bouton) issu d'un autre
répertoire, je voudrais aller rechercher la même zone "Range
("A8:A100")" dans tous les fichiers du répertoire pour les copier dans
mon fichier en cours.
J'ai réussi à lister tous les fichiers du répertoire mais ensuite,
je m'y perd un peu avec "For each".
Merci d'avance pour vos idées.
Julie
bonjour Julie,
x = 1
'boucle sur Tous les fichiers d'un répertoire
For ligne = 8 To 100
Cells(x, 1) = ExecuteExcel4Macro _
("'" & rep & "[" & Fichier & "]Feuil1'!R" & ligne & "C1")
x = x + 1
Next
' Fin boucle Tous les fichiers d'un répertoire
isabelleBonjour à toutes et tous,
J'ai un répertoire avec environ 10 fichiers.
A partir d'un fichier ouvert (macro - bouton) issu d'un autre
répertoire, je voudrais aller rechercher la même zone "Range
("A8:A100")" dans tous les fichiers du répertoire pour les copier dans
mon fichier en cours.
J'ai réussi à lister tous les fichiers du répertoire mais ensuite,
je m'y perd un peu avec "For each".
Merci d'avance pour vos idées.
Julie
bonjour Julie,
x = 1
'boucle sur Tous les fichiers d'un répertoire
For ligne = 8 To 100
Cells(x, 1) = ExecuteExcel4Macro _
("'" & rep & "[" & Fichier & "]Feuil1'!R" & ligne & "C1")
x = x + 1
Next
' Fin boucle Tous les fichiers d'un répertoire
isabelle
Bonjour à toutes et tous,
J'ai un répertoire avec environ 10 fichiers.
A partir d'un fichier ouvert (macro - bouton) issu d'un autre
répertoire, je voudrais aller rechercher la même zone "Range
("A8:A100")" dans tous les fichiers du répertoire pour les copier dans
mon fichier en cours.
J'ai réussi à lister tous les fichiers du répertoire mais ensuite,
je m'y perd un peu avec "For each".
Merci d'avance pour vos idées.
Julie
bonjour Julie,
x = 1
'boucle sur Tous les fichiers d'un répertoire
For ligne = 8 To 100
Cells(x, 1) = ExecuteExcel4Macro _
("'" & rep & "[" & Fichier & "]Feuil1'!R" & ligne & "C1")
x = x + 1
Next
' Fin boucle Tous les fichiers d'un répertoire
isabelleBonjour à toutes et tous,
J'ai un répertoire avec environ 10 fichiers.
A partir d'un fichier ouvert (macro - bouton) issu d'un autre
répertoire, je voudrais aller rechercher la même zone "Range
("A8:A100")" dans tous les fichiers du répertoire pour les copier dans
mon fichier en cours.
J'ai réussi à lister tous les fichiers du répertoire mais ensuite,
je m'y perd un peu avec "For each".
Merci d'avance pour vos idées.
Julie
Bonjour,
Prend les champs A8:A100 et les copie dans la colonne A.
Sub syntèseClasseursBD()
sousRépertoire = "BD"
[A2].Select
fenetre = ActiveWorkbook.Name
ChDir ActiveWorkbook.Path
nf = Dir(sousRépertoire & "*.xls") ' premier fichier
Do While nf <> ""
Workbooks.Open Filename:=sousRépertoire & "" & nf
Windows(fenetre).Activate
Workbooks(nf).ActiveSheet.[A8:A100].Copy ActiveCell
Workbooks(nf).Close False
[A1].End(xlDown).Offset(1, 0).Select
nf = Dir ' fichier suivant
Loop
End Sub
Prend les champs A8:A100 et les copie dans les colonnes A,B,C,
Sub syntèseClasseursBD2()
sousRépertoire = "BD"
[A2].Select
fenetre = ActiveWorkbook.Name
ChDir ActiveWorkbook.Path
nf = Dir(sousRépertoire & "*.xls") ' premier fichier
Do While nf <> ""
Workbooks.Open Filename:=sousRépertoire & "" & nf
Windows(fenetre).Activate
Workbooks(nf).ActiveSheet.[A8:A100].Copy ActiveCell
Workbooks(nf).Close False
[A2].Offset(0, 1).Select
nf = Dir ' fichier suivant
Loop
End Sub
JB
http://boisgontierjacques.free.fr
On 25 sep, 13:41, JulieH wrote:Bonjour à toutes et tous,
J'ai un répertoire avec environ 10 fichiers.
A partir d'un fichier ouvert (macro - bouton) issu d'un autre
répertoire, je voudrais aller rechercher la même zone "Range
("A8:A100")" dans tous les fichiers du répertoire pour les copier dans
mon fichier en cours.
J'ai réussi à lister tous les fichiers du répertoire mais ensuite, je
m'y perd un peu avec "For each".
Merci d'avance pour vos idées.
Julie
Bonjour,
Prend les champs A8:A100 et les copie dans la colonne A.
Sub syntèseClasseursBD()
sousRépertoire = "BD"
[A2].Select
fenetre = ActiveWorkbook.Name
ChDir ActiveWorkbook.Path
nf = Dir(sousRépertoire & "*.xls") ' premier fichier
Do While nf <> ""
Workbooks.Open Filename:=sousRépertoire & "" & nf
Windows(fenetre).Activate
Workbooks(nf).ActiveSheet.[A8:A100].Copy ActiveCell
Workbooks(nf).Close False
[A1].End(xlDown).Offset(1, 0).Select
nf = Dir ' fichier suivant
Loop
End Sub
Prend les champs A8:A100 et les copie dans les colonnes A,B,C,
Sub syntèseClasseursBD2()
sousRépertoire = "BD"
[A2].Select
fenetre = ActiveWorkbook.Name
ChDir ActiveWorkbook.Path
nf = Dir(sousRépertoire & "*.xls") ' premier fichier
Do While nf <> ""
Workbooks.Open Filename:=sousRépertoire & "" & nf
Windows(fenetre).Activate
Workbooks(nf).ActiveSheet.[A8:A100].Copy ActiveCell
Workbooks(nf).Close False
[A2].Offset(0, 1).Select
nf = Dir ' fichier suivant
Loop
End Sub
JB
http://boisgontierjacques.free.fr
On 25 sep, 13:41, JulieH <jul...@discussions.microsoft.com> wrote:
Bonjour à toutes et tous,
J'ai un répertoire avec environ 10 fichiers.
A partir d'un fichier ouvert (macro - bouton) issu d'un autre
répertoire, je voudrais aller rechercher la même zone "Range
("A8:A100")" dans tous les fichiers du répertoire pour les copier dans
mon fichier en cours.
J'ai réussi à lister tous les fichiers du répertoire mais ensuite, je
m'y perd un peu avec "For each".
Merci d'avance pour vos idées.
Julie
Bonjour,
Prend les champs A8:A100 et les copie dans la colonne A.
Sub syntèseClasseursBD()
sousRépertoire = "BD"
[A2].Select
fenetre = ActiveWorkbook.Name
ChDir ActiveWorkbook.Path
nf = Dir(sousRépertoire & "*.xls") ' premier fichier
Do While nf <> ""
Workbooks.Open Filename:=sousRépertoire & "" & nf
Windows(fenetre).Activate
Workbooks(nf).ActiveSheet.[A8:A100].Copy ActiveCell
Workbooks(nf).Close False
[A1].End(xlDown).Offset(1, 0).Select
nf = Dir ' fichier suivant
Loop
End Sub
Prend les champs A8:A100 et les copie dans les colonnes A,B,C,
Sub syntèseClasseursBD2()
sousRépertoire = "BD"
[A2].Select
fenetre = ActiveWorkbook.Name
ChDir ActiveWorkbook.Path
nf = Dir(sousRépertoire & "*.xls") ' premier fichier
Do While nf <> ""
Workbooks.Open Filename:=sousRépertoire & "" & nf
Windows(fenetre).Activate
Workbooks(nf).ActiveSheet.[A8:A100].Copy ActiveCell
Workbooks(nf).Close False
[A2].Offset(0, 1).Select
nf = Dir ' fichier suivant
Loop
End Sub
JB
http://boisgontierjacques.free.fr
On 25 sep, 13:41, JulieH wrote:Bonjour à toutes et tous,
J'ai un répertoire avec environ 10 fichiers.
A partir d'un fichier ouvert (macro - bouton) issu d'un autre
répertoire, je voudrais aller rechercher la même zone "Range
("A8:A100")" dans tous les fichiers du répertoire pour les copier dans
mon fichier en cours.
J'ai réussi à lister tous les fichiers du répertoire mais ensuite, je
m'y perd un peu avec "For each".
Merci d'avance pour vos idées.
Julie
Bonjour à tous les deux et merci pour vos réponses,
J'ai plutôt opté pour la solution de JB qui ressemble plus à ce que
j'imaginais.
En revanche, j'avais oublié de préciser qu'il faut copier en colonne A
mais à la suite. C'est à dire le fichier 1 de A8 à Ax, le fichier 2 de
Ax+1 à Ay...
Juliebonjour Julie,
x = 1
'boucle sur Tous les fichiers d'un répertoire
For ligne = 8 To 100
Cells(x, 1) = ExecuteExcel4Macro _
("'" & rep & "[" & Fichier & "]Feuil1'!R" & ligne & "C1")
x = x + 1
Next
' Fin boucle Tous les fichiers d'un répertoire
isabelleBonjour à toutes et tous,
J'ai un répertoire avec environ 10 fichiers.
A partir d'un fichier ouvert (macro - bouton) issu d'un autre
répertoire, je voudrais aller rechercher la même zone "Range
("A8:A100")" dans tous les fichiers du répertoire pour les copier da ns
mon fichier en cours.
J'ai réussi à lister tous les fichiers du répertoire mais en suite,
je m'y perd un peu avec "For each".
Merci d'avance pour vos idées.
Julie- Masquer le texte des messages précédents -
- Afficher le texte des messages précédents -
Bonjour à tous les deux et merci pour vos réponses,
J'ai plutôt opté pour la solution de JB qui ressemble plus à ce que
j'imaginais.
En revanche, j'avais oublié de préciser qu'il faut copier en colonne A
mais à la suite. C'est à dire le fichier 1 de A8 à Ax, le fichier 2 de
Ax+1 à Ay...
Julie
bonjour Julie,
x = 1
'boucle sur Tous les fichiers d'un répertoire
For ligne = 8 To 100
Cells(x, 1) = ExecuteExcel4Macro _
("'" & rep & "[" & Fichier & "]Feuil1'!R" & ligne & "C1")
x = x + 1
Next
' Fin boucle Tous les fichiers d'un répertoire
isabelle
Bonjour à toutes et tous,
J'ai un répertoire avec environ 10 fichiers.
A partir d'un fichier ouvert (macro - bouton) issu d'un autre
répertoire, je voudrais aller rechercher la même zone "Range
("A8:A100")" dans tous les fichiers du répertoire pour les copier da ns
mon fichier en cours.
J'ai réussi à lister tous les fichiers du répertoire mais en suite,
je m'y perd un peu avec "For each".
Merci d'avance pour vos idées.
Julie- Masquer le texte des messages précédents -
- Afficher le texte des messages précédents -
Bonjour à tous les deux et merci pour vos réponses,
J'ai plutôt opté pour la solution de JB qui ressemble plus à ce que
j'imaginais.
En revanche, j'avais oublié de préciser qu'il faut copier en colonne A
mais à la suite. C'est à dire le fichier 1 de A8 à Ax, le fichier 2 de
Ax+1 à Ay...
Juliebonjour Julie,
x = 1
'boucle sur Tous les fichiers d'un répertoire
For ligne = 8 To 100
Cells(x, 1) = ExecuteExcel4Macro _
("'" & rep & "[" & Fichier & "]Feuil1'!R" & ligne & "C1")
x = x + 1
Next
' Fin boucle Tous les fichiers d'un répertoire
isabelleBonjour à toutes et tous,
J'ai un répertoire avec environ 10 fichiers.
A partir d'un fichier ouvert (macro - bouton) issu d'un autre
répertoire, je voudrais aller rechercher la même zone "Range
("A8:A100")" dans tous les fichiers du répertoire pour les copier da ns
mon fichier en cours.
J'ai réussi à lister tous les fichiers du répertoire mais en suite,
je m'y perd un peu avec "For each".
Merci d'avance pour vos idées.
Julie- Masquer le texte des messages précédents -
- Afficher le texte des messages précédents -
Il est possible de ton extraire sans ouvrir un fichier :
Fonction disponible sur le site de Frédéric Sigonneau
Nécessite une référence à la bibliothèque
"Microsoft ActiveX Data Objects 2.x Library"
'---------------------------------
Function GetValueWithADO(Classeur$, Feuille$, CellAdresse$) As Variant
Dim rcdSet As New ADODB.Recordset
Dim strConn As String
Dim strCmd As String
Dim dummyBase As Range
'prépare une "base de données" bidon pour la clause SELECT
'(une entête fictive et une ligne de données)
Set dummyBase = Range(CellAdresse)
'prépare les commandes ADO
strConn = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Classeur & ";" & _
"Extended Properties=""Excel 8.0;HDR=No;IMEX=1;"";"
strCmd = "SELECT F1 FROM [" & Feuille & "$" & dummyBase.Address(0, 0) & "] Where not isnull(F1) "
'va chercher l'info
rcdSet.Open strCmd, strConn, adOpenStatic, adLockReadOnly, adCmdText
X = rcdSet.RecordCount
GetValueWithADO = Application.Clean(rcdSet.GetRows(X))
End Function
'---------------------------------
Sub test()
Dim Fich As String, Feuil As String, CellAdr As String
Dim Répertoire As String, A As Integer, T As Long, X
'Répertoire de ton choix
Répertoire = "c:AAA"
'le nom de la feuille doit être le même pour chaque fichier
Feuil = "Feuil1"
'La plage de cellule à extraire de ton fichier
'la procédure a été conçu pour une colonne, celle de ton choix
CellAdr = "A15:A20"
On Error Resume Next
If Dir(Répertoire, vbDirectory) <> "" Then
Fich = Dir(Répertoire & "*.xls")
Do While Fich <> ""
A = A + 1
With ThisWorkbook
With .Worksheets("Feuil1")
X = GetValueWithADO(Fich, Feuil, CellAdr)
T = UBound(X)
s = X(4)
'à partir où les données seront copiées
.Range("A4").Resize(T).Columns(A) = _
Application.Transpose(X)
Erase X
End With
End With
Fich = Dir()
Loop
End If
End Sub
"JulieH" a écrit dans le message de news:
eQ9xNk2$
Bonjour à toutes et tous,
J'ai un répertoire avec environ 10 fichiers.
A partir d'un fichier ouvert (macro - bouton) issu d'un autre
répertoire, je voudrais aller rechercher la même zone "Range
("A8:A100")" dans tous les fichiers du répertoire pour les copier dans
mon fichier en cours.
J'ai réussi à lister tous les fichiers du répertoire mais ensuite, je
m'y perd un peu avec "For each".
Merci d'avance pour vos idées.
Julie
Il est possible de ton extraire sans ouvrir un fichier :
Fonction disponible sur le site de Frédéric Sigonneau
Nécessite une référence à la bibliothèque
"Microsoft ActiveX Data Objects 2.x Library"
'---------------------------------
Function GetValueWithADO(Classeur$, Feuille$, CellAdresse$) As Variant
Dim rcdSet As New ADODB.Recordset
Dim strConn As String
Dim strCmd As String
Dim dummyBase As Range
'prépare une "base de données" bidon pour la clause SELECT
'(une entête fictive et une ligne de données)
Set dummyBase = Range(CellAdresse)
'prépare les commandes ADO
strConn = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Classeur & ";" & _
"Extended Properties=""Excel 8.0;HDR=No;IMEX=1;"";"
strCmd = "SELECT F1 FROM [" & Feuille & "$" & dummyBase.Address(0, 0) & "] Where not isnull(F1) "
'va chercher l'info
rcdSet.Open strCmd, strConn, adOpenStatic, adLockReadOnly, adCmdText
X = rcdSet.RecordCount
GetValueWithADO = Application.Clean(rcdSet.GetRows(X))
End Function
'---------------------------------
Sub test()
Dim Fich As String, Feuil As String, CellAdr As String
Dim Répertoire As String, A As Integer, T As Long, X
'Répertoire de ton choix
Répertoire = "c:AAA"
'le nom de la feuille doit être le même pour chaque fichier
Feuil = "Feuil1"
'La plage de cellule à extraire de ton fichier
'la procédure a été conçu pour une colonne, celle de ton choix
CellAdr = "A15:A20"
On Error Resume Next
If Dir(Répertoire, vbDirectory) <> "" Then
Fich = Dir(Répertoire & "*.xls")
Do While Fich <> ""
A = A + 1
With ThisWorkbook
With .Worksheets("Feuil1")
X = GetValueWithADO(Fich, Feuil, CellAdr)
T = UBound(X)
s = X(4)
'à partir où les données seront copiées
.Range("A4").Resize(T).Columns(A) = _
Application.Transpose(X)
Erase X
End With
End With
Fich = Dir()
Loop
End If
End Sub
"JulieH" <julieh@discussions.microsoft.com> a écrit dans le message de news:
eQ9xNk2$HHA.536@TK2MSFTNGP06.phx.gbl...
Bonjour à toutes et tous,
J'ai un répertoire avec environ 10 fichiers.
A partir d'un fichier ouvert (macro - bouton) issu d'un autre
répertoire, je voudrais aller rechercher la même zone "Range
("A8:A100")" dans tous les fichiers du répertoire pour les copier dans
mon fichier en cours.
J'ai réussi à lister tous les fichiers du répertoire mais ensuite, je
m'y perd un peu avec "For each".
Merci d'avance pour vos idées.
Julie
Il est possible de ton extraire sans ouvrir un fichier :
Fonction disponible sur le site de Frédéric Sigonneau
Nécessite une référence à la bibliothèque
"Microsoft ActiveX Data Objects 2.x Library"
'---------------------------------
Function GetValueWithADO(Classeur$, Feuille$, CellAdresse$) As Variant
Dim rcdSet As New ADODB.Recordset
Dim strConn As String
Dim strCmd As String
Dim dummyBase As Range
'prépare une "base de données" bidon pour la clause SELECT
'(une entête fictive et une ligne de données)
Set dummyBase = Range(CellAdresse)
'prépare les commandes ADO
strConn = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Classeur & ";" & _
"Extended Properties=""Excel 8.0;HDR=No;IMEX=1;"";"
strCmd = "SELECT F1 FROM [" & Feuille & "$" & dummyBase.Address(0, 0) & "] Where not isnull(F1) "
'va chercher l'info
rcdSet.Open strCmd, strConn, adOpenStatic, adLockReadOnly, adCmdText
X = rcdSet.RecordCount
GetValueWithADO = Application.Clean(rcdSet.GetRows(X))
End Function
'---------------------------------
Sub test()
Dim Fich As String, Feuil As String, CellAdr As String
Dim Répertoire As String, A As Integer, T As Long, X
'Répertoire de ton choix
Répertoire = "c:AAA"
'le nom de la feuille doit être le même pour chaque fichier
Feuil = "Feuil1"
'La plage de cellule à extraire de ton fichier
'la procédure a été conçu pour une colonne, celle de ton choix
CellAdr = "A15:A20"
On Error Resume Next
If Dir(Répertoire, vbDirectory) <> "" Then
Fich = Dir(Répertoire & "*.xls")
Do While Fich <> ""
A = A + 1
With ThisWorkbook
With .Worksheets("Feuil1")
X = GetValueWithADO(Fich, Feuil, CellAdr)
T = UBound(X)
s = X(4)
'à partir où les données seront copiées
.Range("A4").Resize(T).Columns(A) = _
Application.Transpose(X)
Erase X
End With
End With
Fich = Dir()
Loop
End If
End Sub
"JulieH" a écrit dans le message de news:
eQ9xNk2$
Bonjour à toutes et tous,
J'ai un répertoire avec environ 10 fichiers.
A partir d'un fichier ouvert (macro - bouton) issu d'un autre
répertoire, je voudrais aller rechercher la même zone "Range
("A8:A100")" dans tous les fichiers du répertoire pour les copier dans
mon fichier en cours.
J'ai réussi à lister tous les fichiers du répertoire mais ensuite, je
m'y perd un peu avec "For each".
Merci d'avance pour vos idées.
Julie