Sub Test()
Application.ScreenUpdating = False
With Sheet2
.[A1].CurrentRegion.Columns("B
").AdvancedFilter xlFilterCopy, , .[H1], True
End With
With Sheet1
With .Range("E2:F" & .Cells(Rows.Count, "D").End(xlUp).Row)
.Formula = "=INDEX(BASE!I$1:I$272,MATCH($D2,BASE!$H$1:$H$272,0))"
.Value = .Value
End With
End With
Sheet2.[H1].CurrentRegion.Clear
Application.ScreenUpdating = True
End Sub