En esta macro cambiar nombre agregando día de ejecución y destino
En esta macro:
Sub Guardar_como_Complemento()
'Guardar como Complemento
'Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set l1 = ThisWorkbook
ruta = l1.Path & "J:\MODULOS\"
arch = l1.Name
nomb = Left(arch, InStrRev(arch, ".") - 1)
arch2 = nomb & ".xlam"
l1.SaveCopyAs ruta & "Mio.xlsm"
Workbooks.Open ruta & "Mio.xlsm"
ActiveWorkbook.SaveAs _
Filename:=ruta & arch2, _
FileFormat:=xlOpenXMLAddIn, CreateBackup:=False
ActiveWorkbook.Close False
MsgBox "Complemento guardado"
End Sub
Ponerle este destino:
J:\MODULOS\Mio.xlsm
Y a continuación del nombre, la fecha:
Mio 4.3.2016.xlsm
H o l a
Te paso la macro actualizada
Sub Guardar_como_Complemento() 'Guardar como Complemento 'Act. Aortiz Application.ScreenUpdating = False Application.DisplayAlerts = False Set l1 = ThisWorkbook ruta = "D:\MODULOS\" arch = l1.Name ' fecha = Format(Date, "dd.mm.yyyy") ' nomb = Left(arch, InStrRev(arch, ".") - 1) arch2 = nomb & ".xlam" l1.SaveCopyAs ruta & "Mio " & fecha & ".xlsm" Workbooks.Open ruta & "Mio " & fecha & ".xlsm" ActiveWorkbook.SaveAs _ Filename:=ruta & arch2, _ FileFormat:=xlOpenXMLAddIn, CreateBackup:=False ActiveWorkbook.Close False MsgBox "Complemento guardado" End Sub
valora para finalizar saludos!
Para hacer la prueba puse la ruta D le cambias por J
ruta = "J:\MODULOS\"
Me da error:
l1.SaveCopyAs ruta & "Mio " & fecha & ".xlsm"
Hice la prueba y funciona bien, me crea un archivo con la extensión .xlsm y .xla en la carpeta módulos.
Copia toda la macro y remplaza y asegúrate que la ruta sea la correcta.
Para hacer la prueba puse la ruta D: le cambias por J:
ruta = "J:\MODULOS\"
2 respuestas más de otros expertos
H o l a: Hola Luis, esto que pusiste está mal, le estás poniendo al principio de la ruta, la carpeta del libro actual.
ruta = l1.Path & "J:\MODULOS\"
Debería ser solamente
ruta = "J:\MODULOS\"
Te recomiendo que utilices guiones en la fecha, pediste esto:
Mio 4.3.2016.xlsm
Pero lo recomendable es utilizar guiones:
Mio 4_3_2016.xlsm
además el archivo final será: .xlam (complemento)
La macro completa:
Sub Guardar_como_Complemento() 'Guardar como Complemento 'Por.Dante Amor Application.ScreenUpdating = False Application.DisplayAlerts = False Set l1 = ThisWorkbook ruta = "J:\MODULOS\" 'ruta = l1.Path & "\" arch = l1.Name nomb = Left(arch, InStrRev(arch, ".") - 1) 'arch2 = nomb & ".xlam" arch2 = "mio " & Format(Date, "d_m_yyyy") & ".xlam" l1.SaveCopyAs ruta & "Mio.xlsm" Workbooks.Open ruta & "Mio.xlsm" ActiveWorkbook.SaveAs _ Filename:=ruta & arch2, _ FileFormat:=xlOpenXMLAddIn, CreateBackup:=False ActiveWorkbook.Close False MsgBox "Complemento guardado" End Sub
Si tienes algún problema, tienes que poner el mensaje completo del error y también indicar en qué línea se detiene la macro, entre más información entregues, más fácil será la ayuda que te brindemos.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
Te paso la macro actualizada:
Sub Guardar_como_Complemento() 'Guardar como Complemento 'Por.Dante Amor DatoFecha = Format(Date, "dd-mm-yyyy") Application.ScreenUpdating = False Application.DisplayAlerts = False Set l1 = ThisWorkbook ruta = l1.Path & "J:\MODULOS\" arch = l1.Name nomb = Left(arch, InStrRev(arch, ".") - 1) arch2 = nomb & ".xlam" l1.SaveCopyAs ruta & "Mio.xlsm" & DatoFecha Workbooks.Open ruta & "Mio.xlsm" ActiveWorkbook.SaveAs _ Filename:=ruta & arch2, _ FileFormat:=xlOpenXMLAddIn, CreateBackup:=False ActiveWorkbook.Close False MsgBox "Complemento guardado" End Sub
Si es lo que necesitas no olvides de calificar la respuesta...saludos.
Disculpa me equivoque en el orden de la instrucción, te dejo la macro corregida:
Sub Guardar_como_Complemento() 'Guardar como Complemento 'Por.Dante Amor 'Actualizado por Juan Fernando DatoFecha = Format(Date, "dd-mm-yyyy") Application.ScreenUpdating = False Application.DisplayAlerts = False Set l1 = ThisWorkbook ruta = l1.Path & "J:\MODULOS\" arch = l1.Name nomb = Left(arch, InStrRev(arch, ".") - 1) arch2 = nomb & ".xlam" l1.SaveCopyAs ruta & "Mio" & DatoFecha & ".xlsm" Workbooks.Open ruta & "Mio.xlsm" ActiveWorkbook.SaveAs _ Filename:=ruta & arch2, _ FileFormat:=xlOpenXMLAddIn, CreateBackup:=False ActiveWorkbook.Close False MsgBox "Complemento guardado" End Sub
Si es lo que necesitas no olvides de calificar la respuesta...saludos.
Me da error en :
l1.SaveCopyAs ruta & "Mio" & DatoFecha & ".xlsm"
¿Qué raro a mi me funciona que tipo de error te da?
Ahí se interrumpe la macro
Enviame tu archivo para revisarlo