BackUp de hoja Excel

Sub BackUpHoja()
Dim DateString As String
Dim red As String
Dim NombreArchivo As String
Dim Pregunta As Integer
Sheets("Data").Select

Pregunta = MsgBox("¿Desea generar BackUp de la Data?", vbOKCancel, "Excel Consultor")

    If Pregunta = 2 Then Exit Sub

Zona = Sheets("Hoja1").Range("C1").Value
DateString = Format(Now, "yyyy-mm-dd hh-mm-ss")
NombreArchivo = "BD " & Zona & " " & DateString

Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
Ruta = ActiveWorkbook.Path & "\" & NombreArchivo & ".xlsx"
ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:=Ruta, FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.Close True
MsgBox ("El archivo se guardo con éxito en " & Ruta), vbInformation, "Excel Consultor"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub