السلام عليكم
وجدت الكود المرفق في احدى المشاركات
والمطلوب التعديل عليه بحيث ان تكون النسخة الاحتياطية مؤمنة من اي تعديل ويمكن النسخ منها فقط
ويفضل ان تكون النسخة الاحتياطية بدون الكود
Sub copy1()
Dim Extension$
Dim savePathName As String
Extension = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5) & "Backup" & (Format(Now, " dd-mm-yyyy,hh.mm.ss AMPM")) & ".xls"
savePathName = "c:\Test Backup 1\"
On Error Resume Next
Application.DisplayAlerts = False
GetAttr (savePathName)
Select Case Err.Number
Case Is = 0
Application.DisplayAlerts = False
ThisWorkbook.SaveCopyAs savePathName & Extension
Application.DisplayAlerts = True
Case Else
MkDir savePathName
ThisWorkbook.SaveCopyAs savePathName & Extension
End Select
On Error GoTo 0
End Sub
نسخة.xlsm