Option Explicit
Sub Prix()
Dim WSSource As Worksheet, WSCible As Worksheet
Dim RSource As Range, RCible As Range, RCriteria As Range
Dim LastLigne As Integer
Set WSSource = Worksheets('Base')
Set WSCible = Worksheets('Prix')
WSCible.Cells.Clear
LastLigne = WSSource.Range('B35000').End(xlUp).Row
Set RSource = WSSource.Range('B5:C' & LastLigne)
Set RCible = WSCible.Range('B2:C' & LastLigne - 3)
Set RCriteria = WSSource.Range('B1:C2')
RSource.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=RCriteria, _
CopyToRange:=RCible, _
Unique:=True
End Sub