Boucler une recherche d'infomation sur des fichiers fermés

Bonjour,

Je dispose d'un code me permettant d'extraire des donnés de fichiers fermés en renseignant manuellement dans le code la racine d’accès du dossier et onglet du fichier.

Dans la feuille de calcul, je dispose d'une liste de racines d’accès des fichiers .xls

Tous les fichiers dans lesquels je veut extraire des valeurs sont tramés de la même façon.

J'aimerais que mon code associe la liste de racines d'acces et m'extrait les information en fonction de cellei-ci.

Sub recup()

Range("E7").Select 'sélectionner la cellule de début

Chemin = "D:\AJOURDAN\Mes Documents\ECOTEC 3eme ANNEE\PROJET\VBA FM\Sondages\Sondage001"

fichier = Dir(Chemin & "*.xls")

Do While fichier <> ""

Workbooks.Open Filename:=Chemin & fichier

Set feuille = ActiveWorkbook.Sheets("MAQUETTE")

ThisWorkbook.Activate

ActiveCell.Value = feuille.Range("C3").Value

ActiveCell.Offset(0, 1).Value = feuille.Range("A16").Value

ActiveCell.Offset(0, 2).Value = feuille.Range("A19").Value

ActiveCell.Offset(0, 3).Value = feuille.Range("E23").Value

ActiveCell.Offset(0, 4).Value = feuille.Range("E24").Value

ActiveCell.Offset(0, 5).Value = feuille.Range("E25").Value

Windows(fichier).Close savechanges:=False

ThisWorkbook.Activate

Range("A65536").End(xlUp).Offset(1, 0).Select

fichier = Dir ' Fichier suivant

Loop

End Sub

Merci d'avance

Bonjour,

Au lieu de :

Chemin = "D:\AJOURDAN\Mes Documents\ECOTEC 3eme ANNEE\PROJET\VBA FM\Sondages\Sondage001"

Vous devez écrire:

for i = ligne début liste chemins d'accès à ligne fin liste chemin d'accès

Chemin = sheets(la feuille contenant les chemins d'accès).range(la colonne contenant les chemins d'accès & i)

Next

Bonjour,

Merci pour votre réponse, j'ai intégré le code mais je n'arrive pas à le faire fonctionner.

Je suis un débutant dans le domaine.

Sub recup()

Range("I7").Select 'sélectionner la cellule de début

For i = 7 To 25000

Chemin = Sheets(ActiveSheet).Range("A" & i)

Next

fichier = Dir(Chemin & "*.xls")

Do While fichier <> ""

Workbooks.Open Filename:=Chemin & fichier

Set feuille = ActiveWorkbook.Sheets("MAQUETTE DEVIS")

ThisWorkbook.Activate

ActiveCell.Value = feuille.Range("C3").Value

ActiveCell.Offset(0, 1).Value = feuille.Range("A16").Value

ActiveCell.Offset(0, 2).Value = feuille.Range("A19").Value

ActiveCell.Offset(0, 3).Value = feuille.Range("E23").Value

ActiveCell.Offset(0, 4).Value = feuille.Range("E24").Value

ActiveCell.Offset(0, 5).Value = feuille.Range("E25").Value

Windows(fichier).Close savechanges:=False

ThisWorkbook.Activate

Range("I65536").End(xlUp).Offset(1, 0).Select

fichier = Dir ' Fichier suivant

Loop

End Sub

Quelles actions (selon vous) découlent de ses 3 lignes de code ?

For i = 7 To 25000
Chemin = Sheets(ActiveSheet).Range("A" & i)
Next

C'est pas mal, mais il faut sélectionner le dossier dans lequel on doit faire la recherche.

Alors que dans mon code, la recherche se fait a partir du chemin contenu dans la cellule D2. Et il ne m'extrait que les fichiers au format .xls

La finalité de cet outil est de me faire gagner du temps car les fichiers recherchés s'actualisent tous le temps et aller chercher le dossier principal sur notre serveur serrait un calvaire.

Est'il possible de modifier le code ?


Maise réponse, non je me doute bien que quelque chose suit

mais je ne sais pas du tout ce que cela peut etre, i = i + 1 ?

Pouvez vous m'aider ?

Là n'était pas ma question. Merci de fournir un fichier car je veux savoir où sont écrits vos chemins de fichier.

Non je ne pense d'ou les

Mais je suis incapable d’écrire la suite, i = i + 1

Vous pouvez m'aider ?

Merci de fournir un fichier exemple car je veux savoir où sont écrits (dans quelles cellules) vos chemins de fichier/repertoire

Ci-joint


Dsl mais la taille est trop importante (plus de 300Kio), ci dessous un extrait de l colonne A

D:\AJOURDAN\Mes Documents\ECOTEC 3eme ANNEE\PROJET D'ENTREPRISE\VBA FM\Devis\Devis 001\SLB_devis 001_0_150113_ Inspection réseaux sous dallage.xls

D:\AJOURDAN\Mes Documents\ECOTEC 3eme ANNEE\PROJET D'ENTREPRISE\VBA FM\Devis\Devis 002\SLB_devis 002 ind A _ Mise en place de bâches acoustiques.xls

SLB_devis 002_ Mise en place de bâches acoustiques.xls

D:\AJOURDAN\Mes Documents\ECOTEC 3eme ANNEE\PROJET D'ENTREPRISE\VBA FM\Devis\Devis 003\SLB_devis 003 ind 0 _ Retrait par ponçage ou piochage des zones où la teneur en plomb est sup à 1 mg.xls

SLB_devis 003 ind A_ Projet.xls

SLB_devis 003 ind A_ Retrait par ponçage ou piochage des zones où la teneur en plomb est sup à 1 mg.xls

D:\AJOURDAN\Mes Documents\ECOTEC 3eme ANNEE\PROJET D'ENTREPRISE\VBA FM\Devis\Devis 004\SLB_devis 004 ind 0 _ Grattage des peintures écaillées et plombées.xls

D:\AJOURDAN\Mes Documents\ECOTEC 3eme ANNEE\PROJET D'ENTREPRISE\VBA FM\Devis\Devis 005\SLB_devis 005 ind 0_ Retrait des surfaces repérées plombées dans le rapport TOUSDIAG y compris décalage délai.xls

SLB_devis 005 ind A_ Retrait des surfaces repérées plombées dans le rapport TOUSDIAG y compris décalage délai.xls

D:\AJOURDAN\Mes Documents\ECOTEC 3eme ANNEE\PROJET D'ENTREPRISE\VBA FM\Devis\devis 006\SLB_devis 006 ind 0 _ FM 01 Modifications des sanitaires au RdC.xls

SLB_devis 006 ind A _ FM 01 Modifications des sanitaires au RdC.xls

D:\AJOURDAN\Mes Documents\ECOTEC 3eme ANNEE\PROJET D'ENTREPRISE\VBA FM\Devis\Devis 007\Copie de SLB_devis 007 ind A _ FM 02A Modifications de la salle de crise au RdC.xls

Copie de SLB_devis 007 ind B _ FM 02A Modifications de la salle de crise au RdC.xls


11envoi.xlsx (12.40 Ko)

Dans l'immédiat, testez se fichier en allant sur la feuille 3 et en cliquant sur la forme bleu. Faites moi un retour de ce qu'il s'est passé.

19envoi.xlsm (24.32 Ko)

Bonjour,

C'est pas mal du tout, mais est'il obliger de lister les sous dossiers sur la feuille 2 ?

Pouvez-vous lister les informations sur la même feuille que la liste des chemins ?

Merci pour votre aide

Bonjour, possible oui mais est-ce judicieux ? Comment les différencier des autres liens qui seront quasi identique ?

Je commence à rencontrer des problèmes, la quantité de fichiers devient trop importante, excel peut il effectuer cette recherche sans ouvrir tous les fichiers un après l'autre ?

Je suis parvenu à lister tous les chemins d’accès dans la colonne D :

D:\Mes documents\ecotec\....\projet\projet001\SLB-projet-TS1-.....-.xls

D:\Mes documents\ecotec\....\projet\projet001\SLB-projet-FM04-.....-.xls

D:\Mes documents\ecotec\....\projet\projet002\SLB-projet-TS14-.....-.xls

à partir de ces chemins, j'aimerais extraire 5 cellules par classeur contenu dans le même feuil

N'est-il pas possible de lui imposer une colonne et non d'effectuer une recherche de symbole dans l'ensemble de la feuille ?

If Left(a(i, 1), 3) Like "?:\" Then 'si la cellule commence par une lettre et ":\" (D:\...ou C:\...)

j'y suis parvenu, voici le code

Sub recup()

Set f = ThisWorkbook.Sheets("Feuil1")

'parcourir la colonne 4 (à partir de la ligne 7, jusqu'à la dernière cellule non-vide de cette même colonne)

For lig = 7 To f.Cells(Rows.Count, 4).End(xlUp).Row

'ouvrir chaque fichier dont le chemin d'accès et le nom sont renseignés en colonne D

Workbooks.Open Filename:=f.Cells(lig, 4)

'recopier en colonne F et G de ton fichier (celui contenant la macro), le contenu des cellules A16 et A19, d'une feuille nommée "MAQUETTE DEVIS" dans le ficher qui vient d'être ouvert

ThisWorkbook.Sheets(1).Cells(lig, 9) = ActiveWorkbook.Sheets("MAQUETTE DEVIS").[A16]

ThisWorkbook.Sheets(1).Cells(lig, 10) = ActiveWorkbook.Sheets("MAQUETTE DEVIS").[A19]

ThisWorkbook.Sheets(1).Cells(lig, 11) = ActiveWorkbook.Sheets("MAQUETTE DEVIS").[E23]

ThisWorkbook.Sheets(1).Cells(lig, 12) = ActiveWorkbook.Sheets("MAQUETTE DEVIS").[E24]

ThisWorkbook.Sheets(1).Cells(lig, 13) = ActiveWorkbook.Sheets("MAQUETTE DEVIS").[E25]

'refermer le fichier (celui dont le nom figure en colonne D)

ActiveWorkbook.Close savechanges:=False

Next lig

End Sub

Rechercher des sujets similaires à "boucler recherche infomation fichiers fermes"