macro pour supprimer ttes les macro à une date precise

Private Sub Workbook_Open()
Application.DisplayAlerts = False
On Error Resume Next
Workbooks.Open ThisWorkbook.Path & "\" & "Efface.xls"
Application.OnTime Sheets("Feuil1").Range("A1"), "Efface.xls!EffaceTout"
End Sub

Sub EffaceTout()
Dim F As Object, nomfich As String, n As Integer, i As Integer
Windows(ThisWorkbook.Name).Visible = False
Application.ScreenUpdating = False
Set F = ActiveWorkbook
nomfich = F.Path & "\" & F.Name
n = F.Worksheets.Count
Application.SheetsInNewWorkbook = n
Workbooks.Add
Application.SheetsInNewWorkbook = 3
For i = 1 To n
  F.Worksheets(i).Cells.Copy Sheets(i).[A1]
  Sheets(i).UsedRange = Sheets(i).UsedRange.Value 'supprime les formules
Next
F.Close False: Kill nomfich: ActiveWorkbook.SaveAs nomfich
ThisWorkbook.Close True
End Sub

Sub EffaceTout()
Dim F As Object, nomfich As String, n As Integer, i As Integer
Application.ScreenUpdating = False
On Error Resume Next
For Each F In Workbooks
  [COLOR="Red"]If IsError(F.Names("Marqueur")) Then GoTo 1 'recherche du nom "Marqueur"[/COLOR]
  nomfich = F.Path & "\" & F.Name
  n = F.Worksheets.Count
  Application.SheetsInNewWorkbook = n
  Workbooks.Add
  Application.SheetsInNewWorkbook = 3
  [COLOR="red"]For i = 1 To n
    Sheets(i).Name = Chr(1) & i 'nom provisoire
  Next i[/COLOR]
  For i = 1 To n
    F.Worksheets(i).Cells.Copy Sheets(i).[A1]
    Sheets(i).UsedRange = Sheets(i).UsedRange.Value 'supprime les formules
  [COLOR="red"]  Sheets(i).Name = F.Worksheets(i).Name 'renomme la feuille[/COLOR]
  Next i
  F.Close False: Kill nomfich: ActiveWorkbook.SaveAs nomfich
1 Next F
End Sub