ENVIAR HOJA por correo respetando filtros y con ocultar NO eliminar filas

Tengo esta macro que filtra y guarda copia

Sub PAN_PEDIR()
Application.ScreenUpdating = False
'---MACRO: PASTEL_PEDIR
'---NACRO: COCINA_PEDIR

existe = False
For Each c In Range("G6:AE360")
If Not IsNumeric(c) Then
existe = True
Exit For
End If
Next
If existe Then
MsgBox "No se puede continuar porque hay letras", vbOKOnly, "PROGRAMA DE PEDIDOS"
Else
'continuar
End If
Application.ScreenUpdating = False

If Range("E1") > 0 Then

MsgBox "NO PODEMOS CONTINUAR, PORFAVOR: VERIFIQUE SU PEDIDO", vbExclamation, "LO SENTIMOS"
Exit Sub
End If
Dim s As Long
s = Application.WorksheetFunction.Sum(Range("G6:AE360"))

If s = Empty Then
MsgBox "NO HAY CANTIDADES PARA REALIZAR PEDIDO", vbCritical, "ERROR"

Else

Dim PEDIDO As Variant
' Application.Speech.Speak "¿EL CLIENTE SOLICITARÁ FACTURA?"
PEDIDO = MsgBox("¿REALIZAR PEDIDO?", vbYesNo + vbQuestion, "AVISO")
If PEDIDO = vbYes Then

'FILTRA LOS PRODUCTOS CON MAYOR A CERO
ActiveSheet.Unprotect
ActiveSheet.Range("$F$5:$F$360").AutoFilter Field:=1, Criteria1:=">0", _
Operator:=xlAnd
'IMPRIMIMOS REPORTE APTS
Range("B2:AE360").Select
'Sheets("PANADERIA").Columns("G:AE").EntireColumn.AutoFit
ActiveSheet.PageSetup.PrintArea = "$B$2:$AE$360"
'QUITAMOS RELLENO VERDE
ActiveSheet.Unprotect
Cells.Select
Range("B1").Activate
With Selection.Interior
ActiveSheet.Unprotect
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
'IMPRIMIMOS
OCULTAEXPPAN 
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
Sheets("PANADERIA").Select 
MUESTRAPAN
Application.ScreenUpdating = False
Call guardaCopiaPANADERIA 
'
Sheets("IMPRIME PAN").Activate ' CAMABIAMOS---- HOJA -----DE----- IMPRESION---- SEGUN ---SEA---- LA HOJA
ActiveSheet.Unprotect
ActiveSheet.Range("$C$5:$C$360").AutoFilter Field:=1, Criteria1:=">0", _
Operator:=xlAnd
'QUITAMOS RELLENO VERDE
ActiveSheet.Unprotect
Cells.Select
Range("B1").Activate
With Selection.Interior
ActiveSheet.Unprotect
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
'IMPRIMIMOS POR SEGUNDA VEZ
Range("B2:F366").Select
ActiveSheet.PageSetup.PrintArea = "$B$2:$f$366"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
'REGRESAMOS AL AREA CORRESPONDIENTE
Sheets("PANADERIA").Select 'CAMBIAMOS ----ALA ----HOJA ----QUE TRABAJAMOS
'QUITAMOS FILTRO DEL AREA Y BORRAMOS CONTENIDO
Application.ScreenUpdating = False
ActiveSheet.Unprotect
ActiveSheet.Range("$F$5:$F$360").AutoFilter Field:=1
Range("G6:AE360").Select
ActiveSheet. Unprotect
Selection.ClearContents
Range("G6").Select
'QUITAMOS FILTRO DE IMPRESIÓN
Sheets("IMPRIME PAN").Activate ' CAMABIAMOS---- HOJA -----DE----- IMPRESION---- SEGUN ---SEA---- LA HOJA
ActiveSheet.Range("$C$5:$C$360").AutoFilter Field:=1
'REGRESAMOS DE NUEVO AL AREA
Sheets("PANADERIA").Select 'CAMBIAMOS ----ALA ----HOJA ----QUE TRABAJAMOS
ActiveSheet.Unprotect
[E2] = "PN" & Format(Val(Right([E2], 3)) + 1, "00000") 'CAMBIAR--- FOLIS-- CO:COCINA----PS:PASTEL
MsgBox "PEDIDO REALIZADO", vbOKOnly, "EN HORA BUENA"
If PEDIDO = vbNo Then
MsgBox "PEDIDO CANCELADO", vbInformation, "PANADERIA" 'CAMBIAR ----NOMBRE DE -----MSGBOX---- POR---- AREA
End If
End If
End If
End Sub

Entonces en este código quiero agregar otro que sirve para enviar por correo

Sub CorreoPAN()
'por.Dante Amor
'Enviar una hoja por correo
ActiveSheet.Unprotect
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'
Set L1 = ThisWorkbook
Set h1 = Sheets("PANADERIA")
CEL = h1.[B364]
CEL4 = h1.[E2]
CEL5 = h1.[B2]
ruta = L1.Path & "\"
Set l2 = Workbooks.Add
Set h2 = l2.Sheets(1)
h1.Range("B2:AE360").Copy
h2.[B2].PasteSpecial Paste:=xlValues
h2.[B2].PasteSpecial Paste:=xlPasteFormats
l2.SaveAs Filename:=ruta & h1.Name & ".xlsx", FileFormat:=xlOpenXMLWorkbook
l2.Close
'
Set dam = CreateObject("outlook.application").createitem(0) '
dam.To = "[email protected]"
dam.Subject = "Pedido a Producción Area: " & CEL5 & " Folio : " & CEL4 '"Asunto"
dam.Body = "Pedido Realizado el dia: " & CEL & "CONFIRMA DE RECIBIDO" '"Cuerpo del mensaje"
dam.Attachments.Add ruta & h1.Name & ".xlsx"
dam.Send
ActiveSheet.Protect
MsgBox "Correo enviado y guardado", vbInformation, "PEDIDO DE PANADERIA"
End Sub

Entonces quisiera que cuando yo ejecute el primer código

FILTRE

Guarde una copia

Entonces me ENVÍE por correo la hoja pero que sea con filtros

Para luego me imprima respetando también filtros

Todo FUNCIONA BIEN

Solo falta que me envíe por correo respetando filtros

ESPERO SU AYuda

EN OTRA PREGUNTA ANEXO LOS DEMÁS CÓDIGOS que integran el primer código para así poder anexar el código que envía por correo

Valoro las 2 preguntas

Añade tu respuesta

Haz clic para o