Macro para Guardar Varias Hojas de un libro sin Fórmulas
Escribo para solicitar ayuda con lo siguiente, Manejo una base de datos de 15 páginas y necesito copiar 3 de ellas a un nuevo libro sin fórmulas pero manteniendo el formato de la hoja.
1. Copiar las hojas ("INGRESOS", "SEGURIDAD", "VENEZOLANA") en un nuevo libro
2. Copia valores (sin fórmulas) manteniendo formato de hoja
3. El nuevo libro contiene las tres hojas ("INGRESOS", "SEGURIDAD", "VENEZOLANA")
4. Antes de Guardar Pedir nuevo nombre para el Libro
5. Que Permita la opción de seleccionar la carpeta donde lo quieres guardar.
Uso la siguiente macro:
Sub Guardar()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
Sheets(Array("INGRESOS", "SEGURIDAD", "VENEZOLANA")).Copy
With Application.FileDialog(msoFileDialogSaveAs)
.Title = "Guardar archivo como"
.AllowMultiSelect = False
.Show
myfile = .SelectedItems(1)
ActiveWorkbook.SaveAs Filename:=myfile, FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.Close False
End WithApplication.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
En esta macro soluciono los puntos: "1,3,4,5"
PERO el punto N° 2 . Copia valores (sin fórmulas) manteniendo formato de hoja "NO LOGRO HACERLO"
2 respuestas
Te anexo la macro para copiar solamente el área de impresión
Sub Copiar_Hojas()
'por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set l1 = ThisWorkbook
Application.SheetsInNewWorkbook = 3
Set l2 = Workbooks.Add
hojas = Array("INGRESOS", "SEGURIDAD", "VENEZOLANA")
For h = LBound(hojas) To UBound(hojas)
r = l1.Sheets(hojas(h)).PageSetup.PrintArea
If r <> "" Then
l1.Sheets(hojas(h)).Range(r).Copy
l2.Sheets(h + 1).Range("A1").PasteSpecial Paste:=xlPasteValues
l2.Sheets(h + 1).Range("A1").PasteSpecial Paste:=xlFormats
l2.Sheets(h + 1).Range("A1").PasteSpecial Paste:=xlPasteColumnWidths
End If
Next
'
ruta = ThisWorkbook.Path & "\"
With Application.FileDialog(msoFileDialogSaveAs)
.Title = "Guardar archivo como"
.AllowMultiSelect = False
.InitialFileName = ruta
.FilterIndex = 1
If Not .Show Then Exit Sub
march = .SelectedItems(1)
ActiveWorkbook.SaveAs Filename:=march, _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Close False
MsgBox "Archivo guardado"
End With
End Sub.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
