Sub SearchRef()
Dim Cel As Range, DerLig As Long, ShtD As Worksheet, ShtS As Worksheet
Dim A, B, C
' Initialisation des Feuilles
Set ShtD = Sheets("données")
Set ShtS = Sheets("suivi")
' Initialisation des variables
DerLig = ShtD.Range("A" & Rows.Count).End(xlUp).Row
ShtS.Range("A2:A" & Rows.Count).ClearContents
A = 5: B = 13: C = 20
'
For Each Cel In ShtD.Range("A2:A" & DerLig)
If Cel = ShtS.Range("C5") Then
ShtS.Range("A" & A) = Cel.Offset(0, 1)
A = A + 1
End If
If Cel = ShtS.Range("C13") Then
ShtS.Range("A" & B) = Cel.Offset(0, 1)
B = B + 1
End If
If Cel = ShtS.Range("C20") Then
ShtS.Range("A" & C) = Cel.Offset(0, 1)
C = C + 1
End If
Next Cel
' On vide les variables objets
Set ShtD = Nothing
Set ShtS = Nothing
End Sub
Salut SRBIJA,
Voici le code à placer dans un module
Code:Sub SearchRef() Dim Cel As Range, DerLig As Long, ShtD As Worksheet, ShtS As Worksheet Dim A, B, C ' Initialisation des Feuilles Set ShtD = Sheets("données") Set ShtS = Sheets("suivi") ' Initialisation des variables DerLig = ShtD.Range("A" & Rows.Count).End(xlUp).Row ShtS.Range("A2:A" & Rows.Count).ClearContents A = 5: B = 13: C = 20 ' For Each Cel In ShtD.Range("A2:A" & DerLig) If Cel = ShtS.Range("C5") Then ShtS.Range("A" & A) = Cel.Offset(0, 1) A = A + 1 End If If Cel = ShtS.Range("C13") Then ShtS.Range("A" & B) = Cel.Offset(0, 1) B = B + 1 End If If Cel = ShtS.Range("C20") Then ShtS.Range("A" & C) = Cel.Offset(0, 1) C = C + 1 End If Next Cel ' On vide les variables objets Set ShtD = Nothing Set ShtS = Nothing End Sub
Attention, je ne teste pas l'écrasement possible des références si la liste est plus grande pour un numéro de série !
A+