Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B2]) Is Nothing Then Exit Sub
Dim F As Worksheet, dat As Variant, chemin$, fichier$
Set F = Feuil2 'CodeName
F.Rows("2:" & F.Rows.Count).Delete 'RAZ
dat = [B2]
If Not IsDate(dat) Then Exit Sub
chemin = ThisWorkbook.Path & "\" 'à adapter
fichier = "Source.xlsx" 'à adapter
On Error Resume Next: Workbooks(fichier).Close False: On Error GoTo 0 'si le fichier est ouvert on le ferme
If Dir(chemin & fichier) = "" Then MsgBox "'" & fichier & "' introuvable !", 48: Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'évite les avertissements de mise à jour des liaisons
With Workbooks.Open(chemin & fichier)
With .Sheets(1).[A1].CurrentRegion
.Cells(2, .Columns.Count + 1) = "=A2=" & CLng(CDbl(dat)) 'critère
.AdvancedFilter xlFilterCopy, .Cells(1, .Columns.Count + 1).Resize(2), F.[A1].CurrentRegion 'filtre avancé
End With
.Close False
End With
F.Activate
End Sub