Sub CommandButton18_Click()
Dim wkS As Workbook, wkD As Workbook, s As Worksheet
Dim nf
Set wkS = ThisWorkbook
Set s = wkS.Sheets(1)
s.Range("$A$73:$Q$93").Name = "Tab_1"
Application.ScreenUpdating = False
Set wkD = Workbooks.Add(xlWBATWorksheet)
s.[Tab_1].Copy wkD.Sheets(1).[A5]
nf = _
Application.GetSaveAsFilename(Format(Date, "dd-mm-yyyy_") & _
Format(Time, "h-mm-ss") _
& "_" & wkS.Name & ".xls", _
"FICHIER EXCEL(*.xls), *.xls", 1, _
"Sauvegarde personnalisée")
If nf <> False Then
MsgBox "Classeur enregistré dans : " & nf, _
vbInformation + vbOKCancel, _
"AFFICHAGE DU REPERTOIRE DE SAUVEGARDE"
End If
wkD.SaveAs nf
wkD.Close True
Application.ScreenUpdating = True
End Sub