Sub Transfert()
Dim plage As Range, F As Worksheet, cel As Range, lig As Variant
[COLOR="Red"]Application.ScreenUpdating = False[/COLOR]
Set plage = Sheets("Sheet1").Range("E3:E24")
plage.ClearContents
Set F = Workbooks("Base.xls").Sheets("StatD")
For Each cel In F.Range("I3", F.Range("I65536").Offset(-1))
lig = Application.Match(cel, plage.Offset(, -4), 0)
If IsNumeric(lig) Then plage(lig) = cel.Offset(, 1)
Next
End Sub