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
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 xlvaluesLo 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:=TrueY 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.
