Private Sub Worksheet_Change(ByVal Target As Range) 'au changement dans l'onglet
Dim Cl As Workbook 'déclare la variable Cl (Classeur)
Dim Dest As Range 'déclare la variable Dest (Destination)
Dim BD As Worksheet 'déclare la variable BD (Base de Données)
Dim Pl As Range 'déclare la variable Pl (Plage)
Dim R As Range 'déclare la variable R (Recherche)
Dim PA As String 'Déclare la variable PA (Première Adresse)
'condition : si le changement se fait alleurs qu'en B3 ou si B3 est effacé, sort de la procédure
If Target.Address <> '$B$3' Or Range('B3').Value = '' Then Exit Sub
'définit la variable Cl (remplace par le nom du classeur qui accepte les copies)
Set Cl = Workbooks('Autre Classeur.xls')
'définit la variable Cib (à adapter à ton cas)
Set Dest = Cl.Sheets('Feuil1').Range('A1')
Set BD = Sheets('Base de données') 'définit la variable BD
Set Pl = BD.Range('A2:A' & BD.Range('A65536').End(xlUp).Row) 'définit la variable Pl
With Pl 'prend en compte la plage Pl
Set R = .Find(Target.Value) 'définit la variable R
If Not R Is Nothing Then 'condition : si la recherche n'est pas infructueuse
PA = R.Address 'définit la variable PA
Do 'exécute
R.EntireRow.Copy Destination:=Dest 'copie la ligne et la colle dans la destination
Set Dest = Dest.Offset(1, 0) 'redéfinit la variable Dest (une ligne en dessous)
Set R = .FindNext(R) 'redéfinit la variable R (recherche le suivant)
'tourne en boucle tant que R existe et que son adresse n'est pas la première
Loop While Not R Is Nothing And R.Address <> PA
Else 'sinon
MsgBox 'LA valeur éditée n'existe pas.' 'message
End If 'fin de l acondition
End With 'fin de la prise en compte
End Sub
