OVH Cloud OVH Cloud

VBA recherche valeur d'une même cellule de plusieurs fichiers

13 réponses
Avatar
Fan
Bonjour,

Comment à partir d'un code VBA, rechercher dans tous les fichiers d'un même
répertoire la valeur contenu par exemple dans la cellule A1 de ceux-ci.

Puis rappatrier l'ensemble des valeurs dans une colonne d'un autre fichier.

Je vous remercie par avance

3 réponses

1 2
Avatar
jps
alles verstanden, mein Obersturmführer Denis
danke sehr
jps

"MichDenis" a écrit dans le message de news:

| Hum je ne sais pas si j'ai tout bien compris, daniel mais pas grave...

Juste pour toi ;;;.-)))

Écrite de cette façon, tu n'es pas obligé de fermer le classeur que tu
viens d'ouvrir...
'----------------------------
Sub test()
Dim Dossier As String, Ctr As Long, Fichier As String
Dossier = "C:Atravail"
Ctr = 1
Fichier = Dir(Dossier & "*.xls")
Do While Fichier <> ""
Workbooks.Open Dossier & Fichier
ThisWorkbook.Sheets("Feuil1").Cells(Ctr, 1) = [A1]
Ctr = Ctr + 1
Fichier = Dir
Loop
End Sub
'----------------------------

Dans la premère présentation de la procédure de Daniel, cette ligne de
code :
était écrite de cette manière
Workbooks.Open Fichier

Résultat : Excel cherche dans le cas où le chemin n'est pas indiqué à
UTILISER LE RÉPERTOIRE COURANT ... si le chemin indiqué pour
définir la variable DOSSIER est différent du répertoire courant, la
méthode
open ne pourra trouver le fichier car il n'est pas dans le répertoire
courant
d'où le message que tu as eu.

Par défaut le répertoire courant est celui que tu as défini ou inscrit
dans
Barre des menus / outils / options / onglet Général / "Dossier par
défaut"
Tu peux définir ce dernier par programmation dans l'exécution d'une
procédure
en utilisant :

Chdir "MonNouveauRépertoireParDéfaut" soit "c:Atravail"

Si ce répertoire est sur un autre lecteur, la commande précédente
doit être précédé et écrite comme ceci :
Dossier = "D:Atravail"
ChDrive "D"
Chdir Dossier

Et la procédure serait devenu ceci et on aurait pu utiliser seulement
ceci pour ouvrir le fichier : Workbooks.Open Fichier
'-------------------------
Sub test()
Dim Dossier As String, Ctr As Long, Fichier As String
Dossier = "D:Atravail"
ChDrive "D"
ChDir Dossier
Ctr = 1
Fichier = Dir(Dossier & "*.xls")
Do While Fichier <> ""
Workbooks.Open Fichier
ThisWorkbook.Sheets("Feuil1").Cells(Ctr, 1) = [A1]
Ctr = Ctr + 1
Fichier = Dir
Loop
End Sub
'-------------------------





"jps" a écrit dans le message de news:

Hum je ne sais pas si j'ai tout bien compris, daniel
mais pas grave...
merci en tous cas
jps

"Daniel" a écrit dans le message de news:

Trop merci pour l'immortalisation ;-)))
En fait, quand tu mets :
Workbooks.Open Fichier
le chemin est le chemin par défaut, celui que tu obtiens avec CurDir.
Quand j'ai fait mes tests, le chemin par défaut était par hasard celui
qui
était indiqué dans "Dossier", donc, je n'ai pas eu de problème. Dans le
cas contraire, il faut spécifier le chemin, sinon Excel est perdu et il
le
dit.
Fichier=Dir sert à récupérer le nom du fichier suivant (et là, Excel a
conservé les paramètres passésdans : Fichier = Dir(Dossier & "*.xls")).
Hum je ne sais pas si j'ai été très clair...
Cordialement.
Daniel
"jps" a écrit dans le message de news:

suite....
mais c'est quand même bizarre que le message d'alerte dise "fichier
introuvable" alors qu'il manquait le close du fichier en question (et
des
autres pris dans le...looping)
juste une petite question : le Fichier = Dir juste avant le Loop, il
sert
à quoi?
merci
jps

"Daniel" a écrit dans le message de news:
%
Bien sûr. Au temps pour moi. Et il manquait le "close des fichiers :

Sub test()
Dim Dossier As String, Ctr As Long, Fichier As String
Dossier = "e:donneesdaniel"
Ctr = 1
Fichier = Dir(Dossier & "*.xls")
Do While Fichier <> ""
Workbooks.Open Dossier & Fichier
ThisWorkbook.Sheets("Feuil1").Cells(Ctr, 1) = [A1]
Ctr = Ctr + 1
Workbooks(Fichier).Close False
Fichier = Dir
Loop
End Sub

Daniel
"jps" a écrit dans le message de news:

bonjour daniel
j'ai le même problème
le message est "fichier introuvable" et pourtant le nom du fichier (et
qui est bien le premier de ceux contenus dans le répertoire concerné)
qui s'affiche dans l'avertissement est bien le bon....
le mystère reste entier...
jps

"Daniel" a écrit dans le message de news:

Bonjour.
Peut-être que le fichier est protégé par un mot de passe ? Quel est
le
message ?
Daniel
"Fan" a écrit dans le message de news:

Merci, cela pourrait etre parfait mais il ya une erreur à la
tentative
d'ouverture du 1er fichier.

Une idée ?

Merci

"Daniel" a écrit dans le message de
news:%
Bonjour.
En supposant que chaque classeur n'a qu'une feuille, sinon, on
prend
la
feuille active :

Sub test()
Dim Dossier As String, Ctr As Long, Fichier As String
Dossier = "e:donneesdaniel" '********* A changer
Ctr = 1
Fichier = Dir(Dossier & "*.xls")
Do While Fichier <> ""
Workbooks.Open Fichier
ThisWorkbook.Sheets("Feuil1").Cells(Ctr, 1) = [A1]
Ctr = Ctr + 1
Fichier = Dir
Loop
End Sub

Cordialement.
Daniel
"Fan" a écrit dans le message de news:
%23dj%
Bonjour,

Comment à partir d'un code VBA, rechercher dans tous les fichiers
d'un
même
répertoire la valeur contenu par exemple dans la cellule A1 de
ceux-ci.

Puis rappatrier l'ensemble des valeurs dans une colonne d'un
autre
fichier.

Je vous remercie par avance



































Avatar
MichDenis
Écoute JP, c'est pas parce que ton ami Sarko s'en va
voir la chancelière allemande que tu dois me
répondre en allemand...parce que là j'avoue
que c'est du chinois...
Un peu d'effort dirais ton ami !
;-)


"
alles verstanden, mein Obersturmführer Denis
danke sehr
jps
Avatar
Fan
merci Daniel pour cette nouvelle réponse : parfait

A bientôt
"Daniel" a écrit dans le message de
news:%
Bien sûr. Au temps pour moi. Et il manquait le "close des fichiers :

Sub test()
Dim Dossier As String, Ctr As Long, Fichier As String
Dossier = "e:donneesdaniel"
Ctr = 1
Fichier = Dir(Dossier & "*.xls")
Do While Fichier <> ""
Workbooks.Open Dossier & Fichier
ThisWorkbook.Sheets("Feuil1").Cells(Ctr, 1) = [A1]
Ctr = Ctr + 1
Workbooks(Fichier).Close False
Fichier = Dir
Loop
End Sub

Daniel
"jps" a écrit dans le message de news:

bonjour daniel
j'ai le même problème
le message est "fichier introuvable" et pourtant le nom du fichier (et
qui


est bien le premier de ceux contenus dans le répertoire concerné) qui
s'affiche dans l'avertissement est bien le bon....
le mystère reste entier...
jps

"Daniel" a écrit dans le message de news:

Bonjour.
Peut-être que le fichier est protégé par un mot de passe ? Quel est le
message ?
Daniel
"Fan" a écrit dans le message de news:

Merci, cela pourrait etre parfait mais il ya une erreur à la
tentative




d'ouverture du 1er fichier.

Une idée ?

Merci

"Daniel" a écrit dans le message de
news:%
Bonjour.
En supposant que chaque classeur n'a qu'une feuille, sinon, on prend
la





feuille active :

Sub test()
Dim Dossier As String, Ctr As Long, Fichier As String
Dossier = "e:donneesdaniel" '********* A changer
Ctr = 1
Fichier = Dir(Dossier & "*.xls")
Do While Fichier <> ""
Workbooks.Open Fichier
ThisWorkbook.Sheets("Feuil1").Cells(Ctr, 1) = [A1]
Ctr = Ctr + 1
Fichier = Dir
Loop
End Sub

Cordialement.
Daniel
"Fan" a écrit dans le message de news:
%23dj%
Bonjour,

Comment à partir d'un code VBA, rechercher dans tous les fichiers
d'un
même
répertoire la valeur contenu par exemple dans la cellule A1 de
ceux-ci.

Puis rappatrier l'ensemble des valeurs dans une colonne d'un autre
fichier.

Je vous remercie par avance

























1 2