Sub Sauvegarde_Appointement()
Dim Chemin As String
Dim Question As String
Dim newbook As Workbook
Chemin = ThisWorkbook.Path & "\Sauvegarde des calculs\"
If Dir(Chemin, vbDirectory) = "" Then
'XLLuc on crée d'abord le répertoire si necessaire
MsgBox "Ce dossier n'existe pas"
MkDir ThisWorkbook.Path & "\Sauvegarde des calculs\"
End If
Question = Sheets("App.").Range("c13") & " " & Range("c14") & " " & Format(Date, "dd.mm.yyyy")
Application.ScreenUpdating = False
Sheets("Print App.").Activate
Sheets("Print App.").Visible = -1
'Sheets("Print App.").Copy --> XlLuc pourquoi copier alors qeue tu fait un cells.copy après
Cells.Copy
Cells.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Cells.Validation.Delete
With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
.DeleteLines 1, .CountOfLines
End With
With ActiveWorkbook
.SaveAs Chemin & Question & ".xls"
.Close '<<< supprimer si on veut garder le classeur à l'écran
End With
Sheets("Print App.").Visible = 2
Sheets("App.").Select
'Application.ScreenUpdating = True --> XLluc : inutile si une autre macro n'est pas lancée à la suite, c'est implicite à la fin des procédure
End Sub