Bonjour à tous
J'essaye de créer une routine qui me permettra à terme de :
->fichier de départ fichier1 qui contient la macro
1-parcourir un répertoire et ses sous répertoires
2-chercher des fichiers excel qui portent un nom particulier + suffixe : fichier2
3-les ouvrir un à un
4-chercher dans fichier1 la cellule qui porte la même valeur que la cellule D04 de fichier2
5-cellule trouvée : descendre de 2 lignes (2 cellules)
6-copier coller une plage de données de fichier2 vers fichier1
Je sais faire les étapes 1, 2, 3 et 6. Il me manque les étapes 4 et 5.
Dans un premier temps, je veux améliorer le code ci dessous qui permet uniquement de chercher puis d'afficher les coordonnées de la cellule de fichier1 dont la valeur est égale à la valeur de la cellule D04 du fichier2. Problème : le code me retourne l'emplacement en fichier2 (à savoir colonne 4, ligne 4 qui correspond à D04)
Quelqu'un pourrait me dire ce qui ne va pas ?
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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 Sub search() Dim periode As String Dim celluletrouvee As Range Dim ligne As Integer Dim col As Integer Dim wbSource, wbFichierUsager As Workbook 'PDM jardin.xlsm (fichier1) est affecté à wbFichierUsager Set wbFichierUsager = ThisWorkbook 'ouvrir le fichier2 et cibler la cellule periode Workbooks.Open "C:\Users\fichier2.xls" Set wbSource = ActiveWorkbook periode = Workbooks("fichier2.xls").Worksheets("feuil1").Range("$D$4").Value 'revenir vers le fichier1.xlsm Set wbFichierUsager = ActiveWorkbook 'probleme ici Set celluletrouvee = Range("1:99").Find(periode, lookat:=xlWhole) If celluletrouvee Is Nothing Then MsgBox ("pas trouvé") Else ligne = celluletrouvee.Row col = celluletrouvee.Column MsgBox ("trouvé : ligne = " & ligne & " , colonne = " & col) End If wbSource.Close SaveChanges:=False End Sub
J'essaye de procéder par étapes. Si je suis sur la mauvaise piste, n'hésitez pas à me recadrer.
Merci beaucoup![]()
Partager