Private Sub Worksheet_Activate()
Dim derlig As Long, tablo1, tablo2, lig As Long, i
Application.ScreenUpdating = False
derlig = [B65536].End(xlUp).Row
tablo1 = Application.Transpose(Range("B3:B" & derlig))
tablo2 = Range("C3:D" & derlig)
Sheets("Feuil1").[B3:D65536].Copy [B3]
[C3:D65536].ClearContents
For lig = 3 To [B65536].End(xlUp).Row
i = Application.Match(Cells(lig, "B"), tablo1, 0)
If IsNumeric(i) Then
Cells(lig, "C") = tablo2(i, 1): Cells(lig, "D") = tablo2(i, 2)
End If
Next
End Sub