Te anexo la macro
Sub Enviar_Datos()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'
Set l1 = ThisWorkbook
Set h = Sheets("Hoja1")
'
h.Cells.EntireRow.Hidden = False
h.Cells.EntireColumn.Hidden = False
uf = h.UsedRange.Rows(h.UsedRange.Rows.Count).Row
uc = h.UsedRange.Columns(h.UsedRange.Columns.Count).Column
'
'ocultar filas
For i = uf To 2 Step -1
If LCase(h.Cells(i, "I")) <> LCase("Reclamado") Then
h.Rows(i).EntireRow.Hidden = True
End If
Next
'
'ocultar columnas
h.Range("A:A, C:E, I:M").EntireColumn.Hidden = True
'
'Copiar rango resultante
h. Range(h.Cells(1, "A"), h. Cells(uf, uc)). SpecialCells(xlCellTypeVisible). Copy
Set l2 = Workbooks.Add
Set h2 = l2.Sheets(1)
h2.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths
h2.Range("A1").PasteSpecial Paste:=xlPasteValues
h2.Range("A1").PasteSpecial Paste:=xlPasteFormats
'
'guardar archivo
ruta = l1.Path & "\"
arch = "servicios extras pendientes " & Format(Now(), "dd-mm-yyyy hh_mm_ss")
l2.SaveAs Filename:=ruta & arch & ".xlsx", FileFormat:=xlOpenXMLWorkbook
l2.Close
'
'enviar correo
Set dam = CreateObject("Outlook.Application").CreateItem(0)
dam.To = Sheets("configemail").Range("C15").Value 'Destinatarios
dam.Subject = arch '"Asunto"
dam.Body = "Estimado cliente, adjunto envío los servicios extras pendientes " & _
"a fecha de actualización : " & Format(Date, "dd-mm-yyyy") & _
", atentamente, un saludo."
dam.Attachments.Add ruta & arch & ".xlsx"
Dam. Send 'El correo se envía en automático
'dam. Display 'El correo se muestra
'
'Restaurar todo a visible
h.Cells.EntireRow.Hidden = False
h.Cells.EntireColumn.Hidden = False
Application.ScreenUpdating = True
End Sub
.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.