Sub extraction()
Dim Lig&, c As Range
Lig = 2
Application.ScreenUpdating = False
With Feuil5
.Range("A2:F" & .Rows.Count).ClearContents
If IsNumeric(Application.Match(CLng(Date), Feuil1.[5:5], 0)) Then
For Each c In [tableau3].Columns(Application.Match(CLng(Date), Feuil1.[5:5], 0)).Rows
If c <> "" Then
Feuil1.Range("a" & c.Row & ":f" & c.Row).Copy
.Cells(Lig, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Lig = Lig + 1
End If
Next
Else
MsgBox "Date non présente dans le tableau", , "Information"
End If
.[a1].Activate
End With
End Sub