Bonjour à tous!

Pour effectuer une recherche en boucle dans un fichier spécifique, puis copier des lignes entières dans le fichier où s'exécute la macro je me suis largement inspiré du code présent sur ce fil de discussion.
Après de nombreuses recherches notamment sur ce superbe site, je me vois confronté à un problème que je n'arrive pas à résoudre seul.

Aussi, je viens vous demander de l'aide.

Mon problème: je souhaite effectuer une recherche multi-critère avec le code que j'utilise (i.e. sélectionner des lignes de données qui possèdent 1, 2, etc. valeurs à définir).

Mes questions:

- Comment faire pour adapter le code afin d'effectuer une recherche avec plusieurs critères?

- Existe-t-il une méthode plus simple (j'étais parti sur des boucles "Do While / Loop" au début, mais je n'arrivais pas à trouver exactement ce que je voulais).


Voici le code que j'utilise actuellement:

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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
Option Explicit
 
Dim J As Integer 'variable globale index ligne destination
 
'===================================================================================
'
' stFind : Valeur cherchée
'     rOu: Plage de recherche
'
' Retour = Nb de fois trouvé
'
' Modifier procédure TraiteC en fonction
'  du traitement à effectuer...
Function iBoucleCherche(stFind As String, rOU As Range) As Integer
 Dim c As Range
 Dim stAdd As String 'Memo premier element
 Dim bFinBoucle As Boolean
 Dim iNb As Integer
  Set c = rOU.Find(stFind, After:=rOU.Cells(1), LookIn:=xlFormulas, _
  LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
  MatchCase:=False)
  On Error GoTo 0
  stAdd = c.Address
  bFinBoucle = False
  While Not c Is Nothing And Not bFinBoucle
    iNb = iNb + 1
    TraiteC c
    On Error Resume Next
    Set c = rOU.FindNext(After:=c)
    bFinBoucle = (c.Address = stAdd)
    On Error GoTo 0
  Wend
  iBoucleCherche = iNb
End Function
'
' Fonction de traitement
' A modifier suivant les besoins..
Sub TraiteC(c As Range)
  Debug.Print c.Address & " ... " & c.Value
  '----- le traitement proprement dit...
  ' ici copie ligne entiére dans feuille 2
 
'emplacement où l'on souhaite copier les lignes
  c.EntireRow.Copy ThisWorkbook.Sheets("Data").Rows(J)
  J = J + 1
End Sub
'=======================================================================================
Sub MonTest()
Dim date_du_jour As Variant
Dim classeur As Workbook
Dim CS As Workbook
 
'variable
date_du_jour = Format(CDate(DateSerial(Year(Date), Month(Date), Day(Date) - 1)), "ddmmyyyy")
 
'Classeur source
Set CS = ActiveWorkbook
 
    Application.ScreenUpdating = False
 
'Chercher données dans CSV
Set classeur = Workbooks.Open("\\...\...\STOCK_AU_" & [date_du_jour] & ".csv", _
    False, True, Local:=True)
 
'Boucler sur les données
J = 1 '
    Debug.Print iBoucleCherche(CS.Sheets("Critères").Range("D3").Value, classeur.Sheets("STOCK_AU_" & [date_du_jour]).Cells)
 
 
'Pour fermer le fichier .csv
Workbooks("STOCK_AU_" & [date_du_jour] & ".csv").Close False
 
 
'Rétablir le rafraichissement
    Application.ScreenUpdating = True
 
'Mise en forme: Autofit
Range("A:AZ").Columns.AutoFit
 
End Sub
Concrètement j'aimerai pouvoir utiliser par exemple les cellules D3, D5 et D7 de CS.Sheets("Critères") comme valeurs à définir pour la recherche.


En espérant avoir été assez clair, je reste à votre disposition pour toute précision.


Merci d'avance pour votre aide,




Esculape