Macro para enviar mail a distintas personas si se cumplen varias condiciones (todo un desafio)

[mtejedor]

Estimados:

Tengo una planilla donde llevo un control de certificados medicos, en esta planilla se carga diariamente todos los certificados que recibo, luego se debe informar a cada jefe de sector las personas que estan enfermas.

Como cada empleado tiene un legajo que esta asociado a un sector de la empresa, a un jefe de sector (responsable) y a un centro de costo.

Tengo una macro que me envia un correo a cada jefe de sector asociando el centro de costo con la direccion de correo, esto funciona muy bien.

Hay otra macro que me filtra los empleados que estan con certificados a la fecha, es decir, hoy.

Lo que necesito es ayuda para fusionar estas dos macros porque necesito informar diariamente a cada jefe de Centro de costo quienes son las personas que estan enfermas de su sector siempre y cuando la fecha actual (hoy) se encuentre entre las fechas Desde y Hasta.

Adjunto el archivo "macros para enviar correos).

En la Hoja FiltrarFilas de este archivo hay dos botones:

1. Filtrar ficha desde hasta: me filtra todas las personas que se encuentran enfermas HOY, mirar la columna AUXILIAR
   
2. Enviar hoja actual a las personas de la Hoja Correos: envia un correo a cada jefe usando el centro de costo.
   

El problema que tengo es que solo necesito enviar la informacion que me filtra el primer boton nada mas.

Desde ya muchas gracias.

Macros para enviar correos.rar

[obed_cruz]

Estimado mtejedor, hice algunos cambios en tu código me pareció entender que estos cambios es lo que necesitas, a ver que tal te funciona.

Saludos.

Option Explicit

Sub Send_Row_Or_Rows_1()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim rng As Range
    Dim Ash As Worksheet
    Dim Cws As Worksheet
    Dim Rcount As Long
    Dim Rnum As Long
    Dim FilterRange As Range
    Dim FieldNum As Integer
    Dim mailAddress As String
    Dim FilterRange1 As Range '>>>>Modificado por Obed Cruz<<<<

    On Error GoTo cleanup
    Set OutApp = CreateObject("Outlook.Application")

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set Ash = ActiveSheet

    Set FilterRange1 = Ash.Range("A1:A" & Ash.Rows.Count).SpecialCells(xlCellTypeVisible) '>>>>Modificado por Obed Cruz<<<<
    Set FilterRange = Ash.Range("A1:J" & Ash.Rows.Count)
    FieldNum = 1

    Set Cws = Worksheets.Add
    FilterRange1.Copy Cws.Range("B1") '>>>>Modificado por Obed Cruz<<<<
    Cws.Range("B1:B" & Ash.Rows.Count).AdvancedFilter _
            Action:=xlFilterCopy, _
            CopyToRange:=Cws.Range("A1"), _
            CriteriaRange:="", Unique:=True   '>>>>Modificado por Obed Cruz<<<<

    Rcount = Application.WorksheetFunction.CountA(Cws.Columns(1))

    If Rcount >= 2 Then
        For Rnum = 2 To Rcount

            FilterRange.AutoFilter Field:=FieldNum, _
                                   Criteria1:=Cws.Cells(Rnum, 1).Value

            mailAddress = ""
            On Error Resume Next
            mailAddress = Application.WorksheetFunction. _
                          VLookup(Cws.Cells(Rnum, 1).Value, _
                                Worksheets("Correos").Range("A1:B" & _
                                Worksheets("Correos").Rows.Count), 2, False)
            On Error GoTo 0

            If mailAddress <> "" Then
                With Ash.AutoFilter.Range
                    On Error Resume Next
                    Set rng = .SpecialCells(xlCellTypeVisible)
                    On Error GoTo 0
                End With

                Set OutMail = OutApp.CreateItem(0)

                On Error Resume Next
                With OutMail
                    .To = mailAddress
                    .Subject = "Reporte certificados médicos"
                    .HTMLBody = RangetoHTML(rng)
                    .Display
                End With
                On Error GoTo 0

                Set OutMail = Nothing
            End If

            Ash.UsedRange.AutoFilter Field:=1   '>>>>Modificado por Obed Cruz<<<<

        Next Rnum
     Ash.AutoFilterMode = False
    End If

cleanup:
    Set OutApp = Nothing
    Application.DisplayAlerts = False
    Cws.Delete
    Application.DisplayAlerts = True

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub[/HTML]