Recherche données dans plusieurs fichiers XLS avec argument

Version imprimable

07/08/2014, 16h14
gregory.d

Recherche données dans plusieurs fichiers XLS avec argument

Bonjour à tous

Cela fait plusieurs jours que je tourne sur le net mais je n'arrive pas à trouver la réponse à mon projet sur XLS.

Je ne connait pas vraiment VBA la plupart du temps pour les choses simples je trouve sur le net

Voici mon projet :

1 fichier xlsx "récapitulatif des données".

Je recherche via ce fichier un argument à remplir par l'utilisateur du fichier "un fournisseur par exemple"

A l'aide d'un bouton d'action, il faut recuperer des données comme suit :

- Rechercher dans le dossier "indicateur" tous les fichier xls commencant par "Taux de service XXXXXXXXX"
- Aller à l'onglet "Tous" (des fichiers recherchés à la tache precedente)
- Rechercher les lignes ou "le fournisseur renseigné" est present
- Renvoyer les données de tous les fichiers dans l'onglet "données" du fichier de depart "récapitulatif des données" à partir de la cellule A2

J'espère avoir été le plus clair possible...

Je vous remercie d'avance pour vos réponses.

Grégory
07/08/2014, 19h24
Thautheme

Bonjour Grégory, bonjour le forum,

Pourrais-tu nous indiquer le chemin complet du dossier Indicateur ?
07/08/2014, 19h51
kiki29

Salut, déjà dans la FAQ pour les classeurs fermés.
en adaptant ceci pour lister les fichiers.

Bonsoir Grégory, Kiki, bonsoir le forum,

Ce code à placer dans le classeur récapitulatif des données qui devient donc .xlsm :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
Sub Macro5()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Object 'déclare la variable OD (Onglet Destination)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Object 'déclare la variable OD (Onglet Source)
Dim BE As String 'déclare la variable BE (Boîte d'Entrée)
Dim SF As Object 'déclare la variable SF (Système de Fichiers)
Dim D As Object 'déclare la variable D (Dossier)
Dim FS As Object 'déclare la variable FS (FichierS)
Dim F As Object 'déclare la variable F (Fichier)
Dim PA As String 'déclare la variable PA (Première Adresse)
Dim LI As Integer 'déclare la variable LI (LIgne)
Dim R As Range 'déclare la variable R (Recherche)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
 
Set CD = ThisWorkbook 'définit le classeur de destination CD
Set OD = CD.Sheets("données") 'définit l'onglet de destination OD
Set SF = CreateObject("Scripting.FileSystemObject") 'définit la variable SF
Set D = SF.GetFolder(CD.Path) 'définit la dossier D
Set FS = D.Files 'définit l'ensemble FS des fichiers de D
If FS.Count > 1 Then 'condition : si D possède au moinr un fichier
    BE = InputBox("Argument à rechercher", "RECHERCHE") 'définit la boîte d'entrée BE
    If BE = "" Then Exit Sub 'si BE est vide ou boton "Annuler", sort de la procédure
    For Each F In FS 'boucle sur tous les fichier F de D
        If Left(F.Name, 15) = "Taux de service" Then 'condition 2 : si le nom du fichier commence par "Taux de service"
            Workbooks.Open (F) 'ouvre le fichier
            Set CS = ActiveWorkbook 'définit le classeur source CS
            Set OS = CS.Sheets("Tous") 'définit l'onglet source OS
            Set R = OS.Cells.Find(BE, , xlValues, xlWhole) 'définit la recherche R
            If Not R Is Nothing Then 'consition 3 : si il existe au moins une ocurrence trouvée
                PA = R.Address 'définit l'adresse PA de la première occurrence trouvée
                LI = 0 'définit la ligne li
                Do 'exécute
                    'définit la cellule de destination DEST (A2 si A2 est vide, sinon la première cellule vide de la colonne A de l'onglet OD)
                    Set DEST = IIf(OD.Range("A2").Value = "", OD.Range("A2"), OD.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0))
                    'copie la ligne de l'occurence trouvée et la colle dans DEST
                    'si la ligne de l'occurrence trouvée est différente de la ligne LI
                    If R.Row <> LI Then Rows(R.Row).Copy DEST
                    LI = R.Row 'définit la ligne LI
                    Set R = OS.Cells.FindNext(R) 'redéfinit la recherche R (occurrence suivante)
                Loop While Not R Is Nothing And R.Address <> PA 'boucle tant qu'il existe de nouvelle occurrences ailleurs qu'en PA
            End If 'fin de la condition 3
            CS.Close SaveChanges:=False 'ferme le classeur source sans enregistrer
        End If 'fin de la condition 2
    Next F 'prochaine fichier de la boucle
End If 'fin de la condition 1
End Sub

Ne fonctionne qui si le classeur récapitulatif des données.xlsm se trouve lui aussi dans le dossier indicateur sinon, remplacer la ligne

Code:

Set D = SF.GetFolder(CD.Path) 'définit la dossier D

par :

Code:

Set D = SF.GetFolder(Chemin_complet_du_dossier_indicateur) 'définit la dossier D

08/08/2014, 09h18
gregory.d

Bonjour

Le code fonctionne merci beaucoup !!

Par contre le code pour que le fichier soit en dehors du dossier voulu ne fonctionne pas, c'est un lecteur reseaux...

Avez vous une idée ?
08/08/2014, 12h30
Thautheme

Bonjour Grégory, bonjour le forum,

Citation:

c'est un lecteur reseaux...Avez vous une idée ?

Ooops ! j'ai jamais codé avec des réseaux et je suis à peu près autant qualifié pour ça que l'équipe de France pour gagner la coupe du monde... Ça te donne une bonne idée de mon incompétence, non ?
13/08/2014, 06h47
AlainTech

Bonjour,

Normalement, en donnant l'adresse réseau ça devrait fonctionner de la même manière.
Montre-nous le code qui ne fonctionne pas ainsi que l'erreur qu'il provoque.
13/08/2014, 14h34
Godzestla

Bonjour,
pour adresser un folder réseau, faire comme suit en remplacant server_name par le nom DNS du serveur (ou l'IP) et path par le chemin sur le serveur:

Code:

Set D = SF.GetFolder("\\server_name\path")

NB : Il faut, bien sûr avoir les droits d'accès sur l'endroit en question.:ptdr: