Sub MAJ()
If MsgBox("Mettre à jour les données ?", 4) = 7 Then Exit Sub
Dim F As Worksheet, jour, chemin$, i As Byte, fichier$, dat As Date, tablo, plage As Range
Set F = ActiveSheet 'Sheets("Base de Données cumulative")
jour = Array("Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi", "Samedi", "Dimanche")
chemin = ThisWorkbook.Path & "\" 'C:\Productivity Follow up 2001\autres\ 'à adapter
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si un fichier est déjà ouvert
F.AutoFilterMode = False
On Error Resume Next
For i = 0 To UBound(jour)
'---Ouverture de chaque fichier---
fichier = jour(i) & ".xls" 'extension à adapter pour Excel 2007/2010
Workbooks.Open chemin & fichier
If Err Then MsgBox "Fichier " & fichier & " introuvable...": GoTo 2
With Workbooks(fichier).Sheets(1)
'---Etude du fichier---
.AutoFilterMode = False
dat = CDate(Trim(Replace(Replace(.[J1], "Date", ""), ":", "")))
If Err Or Format(dat, "dddd") <> LCase(jour(i)) Then _
MsgBox "Fichier " & fichier & " : date erronée...": GoTo 1
tablo = .Range("A5:I" & .[A5].End(xlDown).Row)
'---Suppression de la date et restitution sur F
F.[J:J].Replace dat, "z"
F.[J3:J65536].SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete
Err = 0
Set plage = F.[A65536].End(xlUp)(2).Resize(UBound(tablo))
If Err Then MsgBox "Fichier " & fichier & " : plage trop grande...": GoTo 1
plage.Resize(, 9) = tablo
plage.Offset(, 9) = dat
'---Fermeture du fichier---
1 .Parent.Close False
End With
2 Err = 0
Next
'---Tri sur les dates---
F.[A3:J65536].Sort Key1:=F.[J3], Order1:=xlAscending, Header:=xlNo
End Sub