Macro para guardar una copia del archivo en el mismo sitio que el original y con nombre distinto

14.03.17 #VBA guardar copia de archivo plano

Buenos días, Ana

Aquí va la rutina que, además graba el archivo sin sus macros ni el botón, como solicitaste.

Accede al Editor de VBA (Atajo: Alt + F11), allí inserta un módulo (Insertar-Módulo) y pega el siguiente código:

Sub BackArchivo()
'---- Variables modificables:
'ANA, modifica estos datos de acuerdo a tu proyecto:
HojaNombre = "Hoja2" 'hoja donde está la celda que contiene el nombre del archivo
CeldaNombre = "F5" 'direccion de la  celda que contiene el nombre del archivo
BotonMacro = "Shape8"
'---- fin Variables
'
'---- inicio de rutina:
'
DirCopia = ActiveWorkbook.Path & "\"
NomArch = Sheets(HojaNombre).Range(CeldaNombre).Value & "-" & Format(Date, "dd-mm-yy")
Application.ScreenUpdating = False
'Elimina botón de macro, si lo encontrase
On Error Resume Next
ActiveSheet.Shapes(BotonMacro).Delete
Err.Clear
On Error GoTo 0
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs DirCopia & NomArch & ".xlsx"
Application.DisplayAlerts = True
ActiveWorkbook. Close xlNo 'esta linea cierra el archivo grabado. Ssi no la necesitas, anúlala.
End Sub

Nota que, al principio del código, hay unas variables para que lo adaptes a tu archivo

.

Hola Fernando, estoy segura que estoy haciendo algo mal, te pongo la macro adaptada a mi excel:

 HojaNombre = "1.Datos generales proyecto" 'hoja donde está la celda que contiene el nombre del archivo
    CeldaNombre = Range("B11")
    BotonMacro = "Shape8"
    DirCopia = ActiveWorkbook.Path & "\"
    NomArch = Sheets(HojaNombre).Range(CeldaNombre).Value & "-" & Format(Date, "dd-mm-yy")
    Application.ScreenUpdating = False
    'Elimina botón de macro, si lo encontrase
    On Error Resume Next
    ActiveSheet.Shapes(BotonMacro).Delete
    Err.Clear
    On Error GoTo 0
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs DirCopia & NomArch & ".xlsx"
    Application.DisplayAlerts = True
    ActiveWorkbook.Close xlNo  'esta linea cierra el archivo grabado.
   

Me sale un mensaje de error: Se ha producido un error "1004" en tiempo de ejecución: Error definido por la aplicación o el objeto.

Me aparece cuando llega a la línea:

DirCopia = ActiveWorkbook.Path & "\"
    NomArch = Sheets(HojaNombre).Range(CeldaNombre).Value & "-" & Format(Date, "dd-mm-yy")

Muchas gracias.

Te anexo la macro para guardar el archivo como excel "plano", sin macros, en la misma ruta

ub Guardar_Xls()
'---
'   Por.Dante Amor
'---
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    nombre = Sheets("Hoja1").Range("A3")
    If nombre = "" Then
        MsgBox "Falta el nombre del archivo", vbExclamation
        Exit Sub
    End If
    '
    ruta = ThisWorkbook.Path & "\"
    arch = nombre & " " & Format(Date, "dd-mm-yyyy")
    Sheets.Copy
    ActiveWorkbook.SaveAs ruta & arch, FileFormat:=xlOpenXMLWorkbook
    ActiveWorkbook.Close
    Sheets(1).Select
    MsgBox "Archivo guardado: " & arch, vbInformation
End Sub

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

Cambia en la macro "Hoja1" por el nombre de la hoja que tiene la celda con el nombre del archivo. También cambia "A3" por la celda que tiene el nombre del archivo

Sub Guardar_Xls()
'---
'   Por.Dante Amor
'---
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    nombre = Sheets("Hoja1").Range("A3")
    If nombre = "" Then
        MsgBox "Falta el nombre del archivo", vbExclamation
        Exit Sub
    End If
    '
    ruta = ThisWorkbook.Path & "\"
    arch = nombre & " " & Format(Date, "dd-mm-yyyy")
    Sheets.Copy
    ActiveWorkbook.SaveAs ruta & arch, FileFormat:=xlOpenXMLWorkbook
    ActiveWorkbook.Close
    Sheets(1).Select
    MsgBox "Archivo guardado: " & arch, vbInformation
End Sub

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

Estoy haciendo algo mal seguro porque me sale un error:

Se ha prosucido el error "13" en tiempo de ejecución: No coinciden tipos.

Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    nombre = Sheets("1.Datos generales proyecto").Range("B11:H11")
    If nombre = "" Then
        MsgBox "Falta el nombre del archivo", vbExclamation
        Exit Sub
    End If
    '
    ruta = ThisWorkbook.Path & "\"
    arch = nombre & " " & Format(Date, "dd-mm-yyyy")
    Sheets.Copy
    ActiveWorkbook.SaveAs ruta & arch, FileFormat:=xlOpenXMLWorkbook
    ActiveWorkbook.Close
    Sheets(1).Select
    MsgBox "Archivo guardado: " & arch, vbInformation

No he puesto el sub y ni end sub porque esta integrada en una macro, y este sería el final.

Muchísimas gracias.

Si tienes la celda combinada de b11 a h11 solamente pon b11

Perfecto, era eso! Funciona a la perfección.¡Muchas gracias! =)

Ains!siento molestar otra vez!=S

Lo de guardar con el nombre que quiero funciona a la perfección, lo que no hace es eliminar el botón de la macro y dejarlo como en texto "plano".

Gracias.