Sub Test_vr()
Dim ws_1 As Worksheet
Dim ws_2 As Worksheet
Dim Valeur_Test As String
Dim DerniereLigne As Integer
Dim Lig
Set ws_1 = Worksheets(1)
Set ws_2 = Worksheets(2)
Valeur_Test = ws_1.Cells(1, 4).Value
DerniereLigne = ws_2.Cells(65536, 4).End(xlUp).Row
Set Lig = ws_2.Range(ws_2.Cells(1, 4), ws_2.Cells(DerniereLigne, 1)).Find(Valeur_Test, LookIn:=xlValues, LookAt:=xlWhole)
For i = 4 To DerniereLigne
If Not Lig Is Nothing Then
ws_2.Range(ws_2.Cells(i, 1), ws_2.Cells(i, 1)).Copy ws_1.Cells(15, 2)
ws_2.Range(ws_2.Cells(i, 2), ws_2.Cells(i, 2)).Copy ws_1.Cells(15, 4)
ws_2.Range(ws_2.Cells(i, 3), ws_2.Cells(i, 3)).Copy ws_1.Cells(18, 3)
ws_2.Range(ws_2.Cells(i, 5), ws_2.Cells(i, 5)).Copy ws_1.Cells(18, 5)
Else
Exit Sub
End If
Next
End Sub