Macro que guarde más de una hoja activa

Recurro a su expertiz para ver si es factible que una macro guarde más de una hoja de un libro excel.

Resulta que tengo un libro con 5 hojas de calculo, y necesito que una vez que ejecute la macro el resultado lo pueda guardar como libro excel.xls SOLO La hoja llamada"R-HSE-EMCS" y otro "RESUMEN"

Por internet encontré una que funcional muy bien pero solo para la hoja que este activa, igual la comparto.

Me mantengo atento a sus gentiles aportes.

Gracias.

Option Explicit
'
Sub PLANTILLAGuardarHojaComoArchivoNuevo()
'
'Declaramos las variables.
Dim VentanasProtegidas As Boolean
Dim EstructuraProtegida As Boolean
Dim NombreHoja As String
Dim Confirmacion As String
Dim NombreArchivo As String
Dim GuardarComo As Variant
Dim Extension As String
'
'En caso de error.
On Error GoTo ErrorHandler
'
'Validamos si la ventana o la estructura del archivo están protegidos.
VentanasProtegidas = ActiveWorkbook.ProtectWindows
EstructuraProtegida = ActiveWorkbook.ProtectStructure
'
'En caso de estar protegidas mostramos mensaje.
If VentanasProtegidas = True Or EstructuraProtegida = True Then
    MsgBox "No se puede ejecutar el comando cuando la estructura del archivo está protegida.", _
           vbExclamation, "Consolidado"
Else
    '
    'Copiamos la hoja y guardamos.
    NombreHoja = ActiveSheet.Name
    Confirmacion = MsgBox("Desea guardar la hoja '" & NombreHoja & "' como archivo nuevo?", _
                          vbQuestion + vbYesNo, "Consolidado")
    Application.ScreenUpdating = False
    If Confirmacion = vbYes Then
        ActiveSheet.Select
        ActiveSheet.Copy
        NombreArchivo = ActiveWorkbook.Name
        GuardarComo = Application.GetSaveAsFilename(InitialFileName:=NombreHoja, _
            fileFilter:="Libro de Excel(*.xlsx), *.xlsx, Libro de Excel habilitado para macros(*.xlsm), *.xlsm, Libro de Excel 97-2003(*.xls), *.xls,CSV (delimitado por comas)(*.csv),*.csv", _
            Title:="Consolidado - guadar hoja activa como archivo nuevo.")
        If GuardarComo = False Then
            Workbooks(NombreArchivo).Close SaveChanges:=False
        Else
            With Application.WorksheetFunction
                Extension = .Trim(Right(.Substitute(GuardarComo, ".", .Rept(" ", 500)), 500))
            End With
            Select Case Extension
            Case Is = "xlsx"
                ActiveWorkbook.SaveAs GuardarComo
            Case Is = "xlsm"
                ActiveWorkbook.SaveAs GuardarComo, xlOpenXMLWorkbookMacroEnabled
            Case Is = "xls"
                ActiveWorkbook.SaveAs GuardarComo, xlExcel8
            Case Is = "csv"
                ActiveWorkbook.SaveAs GuardarComo, xlCSV
            Case Else
                ActiveWorkbook.SaveAs GuardarComo
            End Select
        End If
    Else
    End If
    '
End If
'
Exit Sub
'
'En caso de error mostramos un mensaje.
ErrorHandler:
MsgBox "Ha ocurrido un error: " & Err.Description, vbExclamation, "Consolidado"
Workbooks(NombreArchivo).Close SaveChanges:=False
'
End Sub

3 Respuestas

Respuesta
1

Solo edite la tuya

Le quite donde copia la hoja y genera libro nuevo.

Option Explicit
'
Sub PLANTILLAGuardarHojaComoArchivoNuevo()
'
'Declaramos las variables.
Dim VentanasProtegidas As Boolean
Dim EstructuraProtegida As Boolean
Dim NombreHoja As String
Dim Confirmacion As String
Dim NombreArchivo As String
Dim GuardarComo As Variant
Dim Extension As String
'
'En caso de error.
On Error GoTo ErrorHandler
'
'Validamos si la ventana o la estructura del archivo están protegidos.
VentanasProtegidas = ActiveWorkbook.ProtectWindows
EstructuraProtegida = ActiveWorkbook.ProtectStructure
'
'En caso de estar protegidas mostramos mensaje.
If VentanasProtegidas = True Or EstructuraProtegida = True Then
    MsgBox "No se puede ejecutar el comando cuando la estructura del archivo está protegida.", _
           vbExclamation, "Consolidado"
Else
    '
    'Copiamos la hoja y guardamos.
    NombreHoja = "todo"
    Confirmacion = MsgBox("Desea guardar la hoja '" & NombreHoja & "' como archivo nuevo?", _
                          vbQuestion + vbYesNo, "Consolidado")
    Application.ScreenUpdating = False
    If Confirmacion = vbYes Then
        NombreArchivo = ActiveWorkbook.Name
        GuardarComo = Application.GetSaveAsFilename(InitialFileName:=NombreHoja, _
            fileFilter:="Libro de Excel(*.xlsx), *.xlsx, Libro de Excel habilitado para macros(*.xlsm), *.xlsm, Libro de Excel 97-2003(*.xls), *.xls,CSV (delimitado por comas)(*.csv),*.csv", _
            Title:="Consolidado - guadar hoja activa como archivo nuevo.")
        If GuardarComo = False Then
            Workbooks(NombreArchivo).Close SaveChanges:=False
        Else
            With Application.WorksheetFunction
                Extension = .Trim(Right(.Substitute(GuardarComo, ".", .Rept(" ", 500)), 500))
            End With
            Select Case Extension
            Case Is = "xlsx"
                ActiveWorkbook.SaveAs GuardarComo
            Case Is = "xlsm"
                ActiveWorkbook.SaveAs GuardarComo, xlOpenXMLWorkbookMacroEnabled
            Case Is = "xls"
                ActiveWorkbook.SaveAs GuardarComo, xlExcel8
            Case Is = "csv"
                ActiveWorkbook.SaveAs GuardarComo, xlCSV
            Case Else
                ActiveWorkbook.SaveAs GuardarComo
            End Select
        End If
    Else
    End If
    '
End If
'
Exit Sub
'
'En caso de error mostramos un mensaje.
ErrorHandler:
MsgBox "Ha ocurrido un error: " & Err.Description, vbExclamation, "Consolidado"
Workbooks(NombreArchivo).Close SaveChanges:=False
'
End Sub
Respuesta
2

Si tu idea es guardar un libro que solo contenga esas 2 hojas que mencionas, esta sería una macro un poco más reducida.

Solo tenés que ajustar el nombre que le darás al nuevo libro y en qué carpeta lo guardarás. Por ahora el nombre es 'Resultados' y se guarda en la misma carpeta que el libro activo.

wb = ActiveWorkbook    'creamos un nuevo Libro
With wb
Application.DisplayAlerts = False
    'guardamos el libro en la misma carpeta
    .SaveAs ThisWorkbook.Path & "\" & nbreLibro & ".xls", FileFormat:=xlExcel8
    .Close    'cerramos el nuevo libro
Application.DisplayAlerts = True
End With
'se libera el objeto
Set wb = Nothing
MsgBox "Libro guardado."
End Sub

Hola Elsa:

Gracias por responder, una consulta.

Por que me sale error 438? al ejecutar el código que me pasaste.

Porque por alguna extraña razón solo se pegó parte del código ;(
Aquí va la macro completa:

Sub guardaLibro()
'x Elsamatilde
nbreLibro = "Resultados"      'ajustar nombre que le darás al nuevo libro
'colocar en la matriz todas las hojas a copiar
Sheets(Array("R-HSE-EMCS", "Resumen")).Copy     'se guardan 2 hojas como libro nuevo
Set wb = ActiveWorkbook    'creamos un nuevo Libro
With wb
Application.DisplayAlerts = False
    'guardamos el libro en la misma carpeta
    .SaveAs ThisWorkbook.Path & "\" & nbreLibro & ".xls", FileFormat:=xlExcel8
    .Close    'cerramos el nuevo libro
Application.DisplayAlerts = True
End With
'se libera el objeto
Set wb = Nothing
MsgBox "Libro guardado."
End Sub

Atención que dejo comentarios para que ajustes detalles si fuese necesario.

Sdos!

¡Gracias! Elsa, si imagine que algo faltaba, del código ya ajuste para que le asigne nombre a mi libro.

Estamos en contacto ya vi que subiste el manual de USE FORMS

Respuesta
1

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas