Macro que guarde solamente los datos en una sola hoja excel

Para Dante Amor,

Dante lo que estoy necesitando para culminar es lo siguiente.

Actualmente hay una macro llama "previa" que filtra las lineas que fueron utilizadas por cada hoja activa y guardaba un pdf por hoja. Ahora necesito que todo lo que queda filtrado de las hojas activas se guarde en una sola hoja en el nuevo libro excel.

Saludos!

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

1 respuesta

Respuesta
1

Te anexo la macro actualizada

Sub GuardarPDF()
'
'   Por Dante Amor
'
    '
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    '
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("Hoja1")        'Primera hoja donde vas a poner el cliente
    Set l2 = Workbooks.Add
    Set h2 = l2.Sheets(1)
    '
    ruta = "C:\trabajo\"
    n = -1
    cliente = h1.Range("G4")
    If cliente = "" Then
        MsgBox "Debes capturar el cliente en la primera hoja", vbCritical
        Exit Sub
    End If
    '
    l1.Activate
    For Each h In l1.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
                u = h.UsedRange.Rows(h.UsedRange.Rows.Count).Row
                u2 = h2.UsedRange.Rows(h2.UsedRange.Rows.Count).Row + 1
                h.Rows("1:" & u).Copy h2.Range("A" & u2)
                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
    '
    l2.SaveAs Filename:=ruta & nomb, _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    l2.Close False
    '
    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)
        '
        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,

Gracias por tu ayuda

Te comento que la macro solo copia los datos de la primera hoja y el nuevo libro que guarda pesa 240 MB. es un disparate ja ja. Cualquier. ¿Capaz qué la estoy complicando demasiado?

Saludos y gracias.

Tienes algunas condiciones. La hoja debe estar visible y la celda L4 debe ser diferente de 0

Cambia esta línea:

h.Rows("1:" & u). Copy h2. Range("A" & u2)

Por esta

h.Rows("1:" & u). Copy 
H2.Range("A" & u2). Pastespecial xlvalues

Lo que hace la macro es copiar todo lo que tengas en las hojas, si tienes espacios, también te copia esos espacios, revisa tus hojas que después de datos no tengas celdas rellenas de espacios.

En la macro original haces el llamada a 2 macros : "previa" y "nuevounificada", no sé qué hagas en esas macros

Prueba nuevamente con el cambio.

Gracias por tu respuesta.

Voy a probar el cambio.

La macro "previa" me filtra por la cantidad >=1 así solo se exportan las filas que se utilizaron.

Capaz que tienes otra idea mejor.

 ActiveSheet.Unprotect
    Columns("N:O").Select
    Selection.EntireColumn.Hidden = True
    Range("J7").Select
    Selection.AutoFilter
    ActiveSheet.Range("$B$7:$P$400").AutoFilter Field:=9, Criteria1:=">=1", _
        Operator:=xlAnd, Criteria2:="<=10000000"
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

Y la Macro Unificada me borra todos las hojas utilizadas.

La idea es que se copian solamente valores, así si tienes fórmulas solamente te va a pegar el resultado de la fórmula.

Prueba con el cambio

Si quieres que revise otra macro, tendrás que terminar las pruebas de este requerimiento y después con gusto reviso la otra macro

Dante, 

Como estas?  probé la macro y funciono bien, lo que me olvide de pedirte si existe la posibilidad que me copie un rango especifico de algunas hojas. se puede hacer?

Muchas gracias por tu ayuda

Con gusto lo reviso, valora esta respuesta y crea una nueva pregunta con el detalle de lo que necesitas. Entre más detallado esté el ejemplo, más práctico será realizar la macro.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas