Guardar Ciertas hojas en libros distintos en la misma ruta

Tardes o noches (según su uso horario), tengo este código para guardar las hojas de mi libro, pero este código guarda todas las hojas que le indique de mi libro en otro libro

Dim VentanasProtegidas As BooleanDim EstructuraProtegida As BooleanDim NombreHoja As StringDim Confirmacion As StringDim NombreArchivo As StringDim GuardarComo As VariantDim 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.ProtectWindowsEstructuraProtegida = 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, "Advertencia"Else    '    'Copiamos la hoja y guardamos.    NombreHoja = ActiveSheet.Name    Confirmacion = MsgBox("Desea guardar la hoja '" & NombreHoja & "' como archivo nuevo?", _                          vbQuestion + vbYesNo, "Confirmacion")    Application.ScreenUpdating = True    If Confirmacion = vbYes Then        Sheets(Array("Hoja1", "incidencia", "SobreTiempo", "Dias_Mezcladoras", "Dias_Bombas", "Tuberias_adicionales", "M3_Volqueta", "M3_Cisterna_Agua", "M3_Cisterna_Cemento")).Copy        Dim semana As Integer ' para calcular el numero de la semana        semana = DatePart("ww", Date, vbMonday) - 1        NombreArchivo = "Nomina semana " & semana        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:="Guardar Como")        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            Application.ActiveWorkbook.Close SaveChanges:=False        End If    Else    End IfEnd If'Application.ActiveWorkbook.Close SaveChanges:=FalseExit Sub''En caso de error mostramos un mensaje.ErrorHandler:MsgBox "Ha ocurrido un error: " & Err.Description, vbExclamation, "ERROR"Workbooks(NombreArchivo).Close SaveChanges:=False

Lo que quiero es que por ejemplo la Hoja1, Hoja2, Hoja3 se guarden en un libro que se llame Nomina

Y las hoja4, hoja5, hoja6, se guarden en otro libro que se llame Controles.

Todo esto en la misma ruta que elijo.

1 respuesta

Respuesta
1

El código aparece todo en 1 sola línea difícil de leerla, pero la idea sería esta:

Al confirmar tenés un array... bien, necesitas 2:

Sheets(Array(Hoja1,... ) todas las que van a pegarse en libro Nómina

Y luego el otro Array. Quizás parte del código pueda aprovecharse para los 2 procesos pero es muy largo el código, trata de mostrarlo en forma de listado si necesitas más ayuda.

Sdos.

Elsa

Hola elsa... No se porque se envío todo en una sola línea si por eso use el editor de código lo pongo aquí para que veas.


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, "Advertencia"
Else
    '
    'Copiamos la hoja y guardamos.
    NombreHoja = ActiveSheet.Name
    Confirmacion = MsgBox("Desea guardar la hoja '" & NombreHoja & "' como archivo nuevo?", _
                          vbQuestion + vbYesNo, "Confirmacion")
    Application.ScreenUpdating = True
    If Confirmacion = vbYes Then
        Sheets(Array("Hoja1", "incidencia", "SobreTiempo", "Dias_Mezcladoras", "Dias_Bombas", "Tuberias_adicionales", "M3_Volqueta", "M3_Cisterna_Agua", "M3_Cisterna_Cemento")).Copy
        Dim semana As Integer ' para calcular el numero de la semana
        semana = DatePart("ww", Date, vbMonday) - 1
        NombreArchivo = "Nomina semana " & semana
        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:="Guardar Como")
        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
            Application.ActiveWorkbook.Close SaveChanges:=False
        End If
    Else
    End If
End If
'Application.ActiveWorkbook.Close SaveChanges:=False
Exit Sub
'
'En caso de error mostramos un mensaje.
ErrorHandler:
MsgBox "Ha ocurrido un error: " & Err.Description, vbExclamation, "ERROR"
Workbooks(NombreArchivo).Close SaveChanges:=False

¿

Además seria posible ponerle contraseñas a estas hojas en el nuevo libro?

Te dejo la macro. No la probé obviamente pero me comentas si algo falla.

Sub manuelEscalona()
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, "Advertencia"
Else
    '
    'Copiamos la hoja y guardamos.
    NombreHoja = ActiveSheet.Name
    Confirmacion = MsgBox("Desea guardar la hoja '" & NombreHoja & "' como archivo nuevo?", _
                          vbQuestion + vbYesNo, "Confirmacion")
    Application.ScreenUpdating = True
    If Confirmacion = vbYes Then
        'ejecuto el proceso 2 veces
        For X = 0 To 1
        If X = 0 Then
        'hojas para el libro Nomina
            Sheets(Array("Hoja1", "incidencia", "SobreTiempo", "Dias_Mezcladoras", "Dias_Bombas", "Tuberias_adicionales", "M3_Volqueta", "M3_Cisterna_Agua", "M3_Cisterna_Cemento")).Copy
            Dim semana As Integer ' para calcular el numero de la semana
            semana = DatePart("ww", Date, vbMonday) - 1
            NombreArchivo = "Nomina semana " & semana
        Else
        'hojas para el libro Controles
             Sheets(Array("Hoja2", "Hoja3")).Copy
            Dim semana As Integer ' para calcular el numero de la semana
            semana = DatePart("ww", Date, vbMonday) - 1
            NombreArchivo = "Controles " & semana
        End If
   'el mismo proceso para los 2 casos
        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:="Guardar Como")
        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
            Application.ActiveWorkbook.Close SaveChanges:=False
        End If
        'repito el bucle
        Next X
    'Else
    End If
End If
'Application.ActiveWorkbook.Close SaveChanges:=False
Exit Sub
'
'En caso de error mostramos un mensaje.
ErrorHandler:
MsgBox "Ha ocurrido un error: " & Err.Description, vbExclamation, "ERROR"
Workbooks(NombreArchivo).Close SaveChanges:=False
End Sub

Lo de la clave

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

Seleccionar Varias hojas y copiar o mover a un nuevo libro

Necesito un código que seleccione varias hojas de un libro para mover o copiar a un libro nuevo la hojas seleccionadas, solo necesito seleccionar la varias hojas que están no estén vacías en la celda a1 de cada hoja, tengo este código pero no logro...
1 respuesta

Macro guardar archivo con nombre de celda en extensión xlsm

Tengo una macro que por seguridad, guarda una copia de un libro actual en una ruta especifica del equipo, tomando el nombre de una celda determinada, la macro es la siguiente: Sub CopiaSeguridad() Dim MiArchivo As String MiArchivo =...
1 respuesta

Como pegar un rango en un libro nuevo seleccionando el rango por medio de CurrentRegion

Intento programar una macro que me jale el contenido de una hoja a un libro nuevo, seleccionando el rango por currentregion, pero al momento de pegarlo en el libro nuevo solo se trae la información de la celda A1, pego el código abajo para mayor...
1 respuesta

Sacar subotales por año arriba en la hoja

Ayudarme a que arriba aparezcan los totales por año de cada inquilino que vayamos a consultar Gracias Sub Buscar() 'Mod.Por.DAM Application.ScreenUpdating = False Set h1 = Sheets("Estados de cuenta") Set h2 = Sheets("Cartera.") '...
1 respuesta

Error en Macro Guardar Libro

Tengo una Macro que lo que hace es preguntar y si le doy yes me dirige a un guardar como segun lo concatenado en una celda, el problema es que si le doy yes, me lleva al guardar como, pero en esa pantalla le coloco cancelar en vez de guardar me salta...
1 respuesta

Crear nueva hoja a varios libros y que esta hoja tenga el formato y contenido de otra hoja?

¿Crear nueva hoja a varios libros y que esta hoja tenga el formato y contenido de otra hoja? ¿Cómo puedo crear nueva hoja a varios libros y que esta nueva hoja tenga el formato y contenido de otra hoja? Es como tener un hoja de plantilla (con datos y...
1 respuesta

Mejorar Macro que importe datos de otro libro-excel

Feliz Navidad Para todos ustedes: Por favor agradeceré ayudarme mejorando esta macro, es que no puedo solucionar. La macro que pongo a continuación realiza lo siguiente -Extrae datos de un libro que yo eligo, de una determinada hoja, en este caso de(...
1 respuesta

Macro guardar como

Jaime como estas. Necesito tu ayuda en esta pequeña macro que no me sale. La idea es asociarla a un botón que abra la ventana de guardar como, pero que en el tipo de archivo unicamente me deje la extensión de libro habilitado para macros. Resumo...,...
2 respuestas

Guardar vía macro con nombre=hora del sistema

Necesito de vuestra inestimable ayuda. Tengo un fichero el cual, a la hora de documentarse una serie de celda, pretendo que, via macro, se haga: - Guardar el fichero con un nombre y dentro de este nombre, se forme con la hora del sistema (hhmmss). -...
1 respuesta

Crear respaldo de libro con nombre de fecha y en escritorio.

Tengo este código: Private Sub Workbook_BeforeClose(Cancel As Boolean)Dim Resp As BooleanResp = FalseResp = IIf(MsgBox("Desea Guardar una Copia?", _vbQuestion + vbYesNo, "Atención") = vbYes, True, False)If Resp...
1 respuesta