Sub CopierValeurs()
Dim wsBD As Worksheet
Dim wsFeuil2 As Worksheet
Dim rng As Range
Dim cell As Range
Dim i As Long
Dim L As Long
Dim R As Long
Dim M As Long
Set wsBD = ThisWorkbook.Sheets("BD")
Set wsFeuil2 = ThisWorkbook.Sheets("Feuil2")
Set rng = wsFeuil2.Range("A5:A" & wsFeuil2.Cells(wsFeuil2.Rows.Count, "A").End(xlUp).Row)
For Each cell In rng
L = 5
R = wsBD.Cells(wsBD.Rows.Count, "A").End(xlUp).Row
Do While L <= R
M = L + (R - L) \ 2
If cell.Value >= wsBD.Cells(M, "A").Value And cell.Value <= wsBD.Cells(M, "B").Value Then
cell.Offset(0, 1).Value = wsBD.Cells(M, "C").Value
cell.Offset(0, 2).Value = wsBD.Cells(M, "D").Value
Exit Do
ElseIf cell.Value < wsBD.Cells(M, "A").Value Then
R = M - 1
Else
L = M + 1
End If
Loop
Next cell
End Sub