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