Blocage recherche + copier-coller

BrunoM45 à dit:

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+

Cliquez pour agrandir...