Sub MAJ()
Dim fichier As Variant, F As Worksheet, ligdeb&, lig&, w As Worksheet, c As Range, i&, dat
fichier = Application.GetOpenFilename("Fichier xlsx(*.xlsx),*.xlsx")
If fichier = False Then Exit Sub
Set F = Sheets("Résumé")
ligdeb = 7
lig = ligdeb + 1
Application.ScreenUpdating = False
F.Range("A" & lig & ":C" & F.Rows.Count).Delete xlUp 'RAZ
With Workbooks.Open(fichier)
For Each w In .Worksheets
Set c = w.Cells(1)
While c <> ""
F.Cells(lig, 1) = w.Name 'onglet
F.Cells(lig, 2) = c 'nom
For i = c.Row + 4 To c.Row + 7
dat = w.Cells(i, 1)
If IsDate(dat) Then If dat > Date Then F.Cells(lig, 3) = dat...