Macro para guardar una hoja de excel
Tengo un libro de Excel que tiene varias hojas. Solamente 1 de esas hojas me interesa guardarla por separado cada día y con un nombre específico que cada día será diferente.
Bien, en principio me plantee exportarlo a Word ya que sería ideal en ese formato, pero al ser tablas las macros que he probado no me exportan bien y el documento Word pierde totalmente la forma y no queda bien.
Ahora necesitaría una macro para guardarlo como Excel pero solos las dos páginas de la hoja que quiero, sin macros ni nada.
1 respuesta
Muchas gracias por la rapida respuesta.
En principio veo la macro genial con la prueba pero en mi proyecto me da los siguientes problemas.
"Msgbox" me pone erro 400
Luego el botón que ejecuta la macro lo tengo en una hoja pero quiero que me guarde otra hoja diferente y no entera, solo "A1:W111"
A pesar del error 400 que te comento, me genera un libro nuevo pero no con el nombre de la celda que le puse, sino como libro1, 2 etc.
un salduo
Utiliza la siguiente macro. Cambia "Hoja1" por el nombre de la hoja que quieras copiar.
Cambia "A3" por la celda que tiene el nombre del archivo
Sub Guardar_Version_De_La_Hoja()
'Por Dante Amor
'5 Enero 2018
'
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.CopyObjectsWithCells = False
'
hoja = "Hoja1"
ruta = ThisWorkbook.Path & "\"
arch = Sheets(hoja).Range("A3")
'
prefijo = ""
ver = ""
ext = ".xlsx"
una = True
Do While True
If Dir(ruta & arch & prefijo & ver & ext) <> "" Then
prefijo = "_v"
If una Then
ver = 1
una = False
Else
ver = ver + 1
End If
Else
Exit Do
End If
Loop
'
Set l1 = ThisWorkbook
Set h1 = l1.Sheets(hoja)
Set l2 = Workbooks.Add
Set h2 = l2.Sheets(1)
h1.Range("A1:W111").Copy h2.Range("A2")
l2.SaveAs Filename:=ruta & arch & prefijo & ver & ext, _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
l2.Close False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.CopyObjectsWithCells = True
MsgBox "Archivo guardardo con el nombre: " & arch & prefijo & ver & ext
End Sub
.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
Buenas noches, la macro funciona a la perfección y cumple su función. Dos problemas le he visto pero creo que poco se podrá hacer.
El primer problema que en la celda dónde pongo el nombre que quiero para el archivo, si pongo una fecha me da error, poniendo texto va a la perfección.
El otro problema es que la hoja que quiero copiar, las columnas y filas las tengo configuradas con anchuras y alturas especificadas por mí según las necesitaba y me el documento nuevo que me genera lo genera con las medidas extandar, las medidas iniciales de Excel, no me respeta el formato que le tengo dado en medida, no sé si me explico.
Muchas gracias
La macro perfecta.
Le encuentro dos problemas pero que supongo que no se podrá hacer nada
Primero: si la celda dónde pongo el nombre del archivo es una fecha me da error, si es texto lo guarda con el contenido de la celda perfecto.
El Segundo: la hoja que quiero guardar la tengo configuradas con anchura de columnas y altura de filas diferente a lo predeterminado por Excel, el documento nuevo que me genera lo genera con las medidas predeterminadas no me guarda las mías.
Perdona que te moleste más, ¿Existe la posibilidad de laque la nueva hoja que guarde lo haga con las medidas de las celdas de origen?
Muchas gracias por todo
Te anexo la macro actualizada para guardar con fecha y con los formatos de fila y columna
Sub Guardar_Version_De_La_Hoja()
'Por Dante Amor
'5 Enero 2018
'
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.CopyObjectsWithCells = False
'
hoja = "Hoja1"
ruta = ThisWorkbook.Path & "\"
arch = Format(Sheets(hoja).Range("A3"), "dd-mm-yyyy")
'
prefijo = ""
ver = ""
ext = ".xlsx"
una = True
Do While True
If Dir(ruta & arch & prefijo & ver & ext) <> "" Then
prefijo = "_v"
If una Then
ver = 1
una = False
Else
ver = ver + 1
End If
Else
Exit Do
End If
Loop
'
Set l1 = ThisWorkbook
Set h1 = l1.Sheets(hoja)
h1.Copy
Set l2 = ActiveWorkbook
Set h2 = l2.Sheets(1)
'h1.Range("A1:W111").Copy h2.Range("A2")
h2.Rows("112:" & Rows.Count).Clear
h2.Range("X1", h2.Cells(Rows.Count, Columns.Count)).Clear
l2.SaveAs Filename:=ruta & arch & prefijo & ver & ext, _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
l2.Close False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.CopyObjectsWithCells = True
MsgBox "Archivo guardardo con el nombre: " & arch & prefijo & ver & ext
End Sub
sal u dos
