Set objFSO = CreateObject("Scripting.FileSystemObject")
If Dir(ThisWorkbook.Path & "\Backup", vbDirectory) = "" Then MkDir ThisWorkbook.Path & "\Backup"
mabackup = ThisWorkbook.Path & "\Backup" & "\sauv_" & Format(tmp1, "ddmmyyyy") & ".xls"
Montableau= ThisWorkbook.Path & "\principal.xls"
If Not objFSO.FileExists(mabackup) Then
ActiveWorkbook.SaveAs Filename:=mabackup
End If
Application.DisplayAlerts = False
ThisWorkbook.SaveAs Montableau
Application.DisplayAlerts = True
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=NomFichier 'j'enregistre l'original
Dim sh As Worksheet
For Each sh In Worksheets
If InStr(1, "feuil1,feuil2,feuil3, sh.Name) = 0 Then sh.Delete
Next sh
ActiveWorkbook.SaveAs Filename:=RecapFile 'j'enregistre le fichier modifié
Application.DisplayAlerts = True
'suppression macros
' Cocher Outils | Reférence Microsoft Visual Basic for Applications Extensibility 5.3
Dim VBComp As VBIDE.VBComponent
Dim VBComps As VBIDE.VBComponents
Set VBComps = ThisWorkbook.VBProject.VBComponents
For Each VBComp In VBComps
Select Case VBComp.Type
Case vbext_ct_StdModule, vbext_ct_MSForm, vbext_ct_ClassModule
VBComps.Remove VBComp
Case Else
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
End Select
Next
' fin supression macros
Set VBComps = ThisWorkbook.VBProject.VBComponents
Set VBComps = ActiveWorkbook.VBProject.VBComponents
ActiveWorkbook.SaveAs Filename:=NomFichier
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=RecapFile
Workbooks(Recap).Close
If objFSO.FileExists(RecapFile) Then
On Error Resume Next
Set wkB = Workbooks.Open(RecapFile)
'Copier les feuilles
ThisWorkbook.Sheets("Recap 1").Copy before:=wkB.Sheets(1)
ActiveSheet.Name = ThisWorkbook.Sheets("Recap 1")
ThisWorkbook.Sheets("Gestion ATE").Copy before:=wkB.Sheets(2)
ActiveSheet.Name = ThisWorkbook.Sheets("Recap 2")
ThisWorkbook.Sheets("Recap S").Copy before:=wkB.Sheets(3)
ActiveSheet.Name = ThisWorkbook.Sheets("Recap 3")
ThisWorkbook.Sheets("Recap F").Copy before:=wkB.Sheets(4)
ActiveSheet.Name = ThisWorkbook.Sheets("Recap 4")
ThisWorkbook.Sheets("Recap C").Copy before:=wkB.Sheets(5)
ActiveSheet.Name = ThisWorkbook.Sheets("Recap 5")
'Détruire les éventuels objets shapes de la feuille
For Each ctl In ActiveSheet.Shapes
ctl.Delete
Next
ActiveWorkbook.SaveAs Filename:=RecapFile
Workbooks(Recap).Close
...car cette Recap n'est là que pour être consulté ...
ActiveSheet.Shapes.SelectAll: Selection.Delete