Private Sub CommandButton5_Click()
        'Резервное копирование с датой и временем копирования в папку D:/BACUP
            Dim x As String
        Dim strDate, strPath, BookName, bookextension, j, FileNameXls 'объявили переменные
            
        strPath = " D:\BACUP"     'папка для сохранения резервной копии
            If Err = 0 Then ' если путь существует - сохраняем копию книги, добавляя дату-время
            strDate = Format(Now, "yy-mm-dd hh-mm")
                 'WorkbookName()
                    BookName = ActiveWorkbook.Name
            'задаем расширение по умолчанию если файл еще ни разу не сохранялся
            If Application.Version = "12.0" Or Application.Version = "14.0" Then
                bookextension = "xlsx"
            Else
                bookextension = "xls"
            End If
            'вытаскиваем настоящее расширение
            For j = Len(BookName) To 1 Step -1
                If Mid(BookName, j, 1) = "." Then
                    bookextension = Right(BookName, Len(BookName) - j)
                    BookName = Left(BookName, j - 1)
                    Exit For
                End If
            Next j
            'сохраняем резервную копию
            FileNameXls = strPath & "\" & BookName & " " & strDate & "." & bookextension
            ActiveWorkbook.SaveCopyAs Filename:=FileNameXls
            MsgBox "Создана копия файла  " & BookName & " " & strDate & " в папку " & strPath
        Else 'если путь не существует - выводим сообщение
            MsgBox "Папка " & strPath & " недоступна или не существует!", vbCritical
        End If
End Sub