Exportar a excel a un solo libro

Para Dante amor

Hace un tiempo me ayudaste con esta macro, el funcionamiento de la misma era que me guardaba en formato pdf las hojas que utilizaba según un parámetro.

Ahora necesito que me lo guarde en formato excel.

La idea si es posible que me guarde todas las filas de las distintas hojas utilizadas en un nuevo libro.

Muchas gracias por tu ayuda.

Sub GuardarPDF()
    Dim hojas()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    ruta = "C:\trabajo\"
    'ruta = "C:\trabajo\"
    n = -1
    Set h1 = Sheets("Hoja1")        'Primera hoja donde vas a poner el cliente
    '
    cliente = h1.Range("G4")
    If cliente = "" Then
        MsgBox "Debes capturar el cliente en la primera hoja", vbCritical
        Exit Sub
    End If
    '
    For Each h In Sheets
        If h.Visible = -1 Then
            h.Select
            ActiveSheet.Unprotect
            h.[G4] = cliente
            If h.[L4] <> 0 Then
                h.Select
                Call Previa
                n = n + 1
                ReDim Preserve hojas(n)
                hojas(n) = h.Name
                If nomb = "" Then
                    nomb = h.[G4] & " " & Format(h.Range("G2"), "dd-mm-yyyy") + Format(Now, "(hh'mm)") & ".pdf"
                End If
            End If
     End If
    Next
    '
    If n > -1 Then
        usuario = Environ$("computername")
        Set h = Sheets("usuarios")
        Set b = h.Columns("A").Find(usuario)
        If b Is Nothing Then
            MsgBox "El usuario: " & usuario & " no existe en la hoja 'usuarios'", vbCritical
            Exit Sub
        End If
        '
        correos = b.Offset(0, 1)
        Sheets(hojas).Copy
        ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ruta & nomb, _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
        ActiveWorkbook.Close False
        '
        Set dam = CreateObject("outlook.application").createitem(0)
        dam.To = correos
        dam.Subject = nomb
        dam.Body = "Orden de Pedido"
        dam.Attachments.Add ruta & nomb
        dam.Display 'El correo se envía en automático
        'dam.Display 'El correo se muestra
        '
        MsgBox "Orden lista para enviar, favor revisar correo"
    End If
    Call NuevoUnificada
End Sub

2 respuestas

Respuesta
1
Respuesta
1

Te anexo la macro actualizada. Te guarda el archivo en formato excel

Sub GuardarPDF()
'
'   Por Dante Amor
'
    '
    Dim hojas()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    ruta = "C:\trabajo\"
    n = -1
    Set h1 = Sheets("Hoja1")        'Primera hoja donde vas a poner el cliente
    '
    cliente = h1.Range("G4")
    If cliente = "" Then
        MsgBox "Debes capturar el cliente en la primera hoja", vbCritical
        Exit Sub
    End If
    '
    For Each h In Sheets
        If h.Visible = -1 Then
            h.Select
            ActiveSheet.Unprotect
            h.[G4] = cliente
            If h.[L4] <> 0 Then
                h.Select
                Call previa
                n = n + 1
                ReDim Preserve hojas(n)
                hojas(n) = h.Name
                If nomb = "" Then
                    nomb = h.[G4] & " " & Format(h.Range("G2"), "dd-mm-yyyy") + Format(Now, "(hh'mm)") & ".xlsx"
                End If
            End If
        End If
    Next
    '
    If n > -1 Then
        usuario = Environ$("computername")
        Set h = Sheets("usuarios")
        Set b = h.Columns("A").Find(usuario)
        If b Is Nothing Then
            MsgBox "El usuario: " & usuario & " no existe en la hoja 'usuarios'", vbCritical
            Exit Sub
        End If
        '
        correos = b.Offset(0, 1)
        Sheets(hojas).Copy
'        ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ruta & nomb, _
'            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
'            IgnorePrintAreas:=False, OpenAfterPublish:=False
        ActiveWorkbook.SaveAs Filename:=ruta & nomb, _
            FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        ActiveWorkbook.Close False
        '
        Set dam = CreateObject("outlook.application").createitem(0)
        dam.To = correos
        dam.Subject = nomb
        dam.Body = "Orden de Pedido"
        dam.Attachments.Add ruta & nomb
        'dam.Send 'El correo se envía en automático
        dam.Display 'El correo se muestra
        '
        MsgBox "Orden lista para enviar, favor revisar correo"
    End If
    Call NuevoUnificada
End Sub

.

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

.

Avísame cualquier duda

.

Dante, muchas gracias por tu ayuda.

Sabes que a la hora de exportar  me pasan dos cosas.                                                                              La primera es que me guarda hasta las macros del libro original, hay posibilidades de que no exporte las macros ni ?                                                                                                                                        La segunda es actualmente se exportan todas las hojas que utilizo, hay posibilidades de exportar todo a una misma hoja?. te paso un ejemplo de esta parte.

Ya lo revisé y no exporta las macros, el archivo es guardado como xlsx (sin macros), a lo mejor solamente ves los botones de las macros, pero si revisas en VBA no hay ninguna macro en el nuevo libro.

La macro es para guardar todas las hojas en otro libro, para eso es esta instrucción:

Sheets(hojas). Copy

En tal caso necesitarías otra macro que guarde solamente los datos en una sola hoja. Con gusto te hago los cambios para una nueva macro. Valora esta respuesta y crea la pregunta correspondiente.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas