Sub MAJmodif()
Dim pDossier$, pRepMaj$, nFichier
Dim nDate As Date, sDte$, aDate$
Dim wb As Workbook
Application.ScreenUpdating = False
pRep = "h:\Secretariat Assistantes\AIFM (rappro)\Rappro test\"
nDate = VBA.Date - Weekday(VBA.Date - 6)
sDate = Format(nDate, "yyyymmdd")
pRepMaj = pRep & "MAJ_" & sDate
If Dir(pRepMaj, 16) = "" Then
MkDir pRepMaj
Else
MsgBox "MAJ déjà effectuée pour le " & nDate & vbCr & "Opération annulée", vbExclamation
Exit Sub
End If
aDate = Format(VBA.Date, "yyyymmdd")
nFichier = Dir(pRep & "*" & aDate & "*.xls")
Do
If nFichier <> "" Then
Set wb = Workbooks.Open(pRep & nFichier)
With wb
For i = .Sheets.Count To 1 Step -1
With .Sheets(i)
If .[A2] <> "" Then
.[A2].Clear
.[A2] = nDate
Else
Application.DisplayAlerts = False
On Error Resume Next
.Delete
Application.DisplayAlerts = True
On Error GoTo 0
End If
End With
Next
nFichier = Replace(nFichier, aDate, sDate)
.SaveAs pRepMaj & "\" & nFichier
.Close
End With
End If
nFichier = Dir()
Loop Until nFichier = ""
End Sub