Boucle infinie si filtre appliqué sur mes données

 
Public Sub Envoi_Mail_DCO(typeMail As String, etatInitial As String)

    ' On définit tout nos objets
    Dim OutApp As Object, OutMail As Object, Signature As String
    Dim cell As Range, rng As Range, rngSelection As Range
    Dim candidatsSheet As Worksheet, mailSheet As Worksheet
    Dim eMail As String
    Dim PRENOM As String
    Dim NOM As String
    Dim etatDCO As String, etatTest As String
    Dim corpsTexte As String, formuleBonjour As String
    Dim sujet As String
    Dim ETAT As String
    Dim colPrenom As Integer
    Dim colNom As Integer
    Dim colMail As Integer
    Dim colDCO As Integer
    Dim colTest As Integer
    Dim colRelanceDCO As Integer
    Dim colRelanceTest As Integer

    Dim NombreEmails As Integer
    NombreEmails = 0

    Set OutApp = CreateObject("Outlook.Application")
    Set candidatsSheet = Worksheets("CANDIDATS") ' Feuille des candidats
    Set mailSheet = Worksheets("MAIL") ' Feuille des mails
    Set rngSelection = Selection 'Sélection

    'Trouver les colonnes
    colPrenom = Cherche_ColonneXL(candidatsSheet, "PRENOM")
    colNom = Cherche_ColonneXL(candidatsSheet, "NOM")
    colMail = Cherche_ColonneXL(candidatsSheet, "MAIL")
    colDCO = Cherche_ColonneXL(candidatsSheet, "DCO")
    colTest = Cherche_ColonneXL(candidatsSheet, "TEST Technique")
    colRelanceDCO = Cherche_ColonneXL(candidatsSheet, "RELANCE DCO")
    colRelanceTest = Cherche_ColonneXL(candidatsSheet, "RELANCE TEST")

    ' On empêche la sélection de plusieurs lignes
    If Selection.Columns.count > 1 Then
        MsgBox "Merci de ne sélectionner qu'une seule colonne. Vous pouvez uniquement sélectionner plusieurs lignes.", vbExclamation, "Erreur"
        Exit Sub
    Else

        ' On récupère la signature enregistrée dans Outlook
        Set OutMail = OutApp.CreateItem(0)
        Signature = OutMail.HTMLBody
        OutMail.Close False ' Ferme le mail utilisé pour récupérer la signature sans l'envoyer

        On Error Resume Next
        Set rng = rngSelection.SpecialCells(xlCellTypeVisible)
        On Error GoTo 0

        If rng Is Nothing Then
            MsgBox "Il n'y a pas de cellules visibles dans la sélection."
            Exit Sub
        End If

        For Each cell In rng
            eMail = candidatsSheet.Cells(cell.Row, colMail).Value
            PRENOM = candidatsSheet.Cells(cell.Row, colPrenom).Value
            NOM = candidatsSheet.Cells(cell.Row, colNom).Value
            etatDCO = candidatsSheet.Cells(cell.Row, colDCO).Value
            etatTest = candidatsSheet.Cells(cell.Row, colTest).Value

            If eMail <> "" And Not cell.EntireRow.Hidden Then

                If etatDCO = "Pas envoyé" And typeMail = "DCO" And etatInitial = "Pas envoyé" Then
                    ETAT = "DCO - Pas envoyé"
                ElseIf etatDCO = "Envoyé / Pas réalisé" And typeMail = "DCO" And etatInitial = "Envoyé / Pas réalisé" Then
                    ETAT = "DCO - Envoyé / Pas réalisé"
                ElseIf etatTest = "Pas envoyé" And typeMail = "TEST" And etatInitial = "Pas envoyé" Then
                    ETAT = "TEST - Pas envoyé"
                ElseIf etatTest = "Envoyé / Pas réalisé" And typeMail = "TEST" And etatInitial = "Envoyé / Pas réalisé" Then
                    ETAT = "TEST - Envoyé / Pas réalisé"
                Else
                    GoTo NextIteration
                End If

                NombreEmails = NombreEmails + 1

                corpsTexte = mailSheet.Cells(Application.Match(ETAT, mailSheet.Range("A:A"), 0), 2).Value
                sujet = mailSheet.Cells(Application.Match(ETAT, mailSheet.Range("A:A"), 0), 3).Value

                formuleBonjour = "Bonjour " & PRENOM & " " & NOM & ",<br><br>"

                Set OutMail = OutApp.CreateItem(0)
                With OutMail
                    .To = eMail
                    .Subject = sujet
                    .Display ' Affiche l'aperçu avant d'envoyer encore une fois
                    .HTMLBody = formuleBonjour & corpsTexte & "<br>" & .HTMLBody
                End With
                Set OutMail = Nothing

            End If
NextIteration:
      Next cell

      If NombreEmails = 0 Then ' Si aucun e-mail n'a été envoyé
          MsgBox "Aucun e-mail ne correspond à votre relance. Veuillez vérifier les conditions de votre sélection."
      End If

    End If
    Set OutApp = Nothing

End Sub

bonjour,

il semblerait qu'il y ait un problème avec la plage rng dès lors qu'il s'agit d'une plage filtrée avec un seul élément. Il ne me semble pas que ce soit un bug dans ta macro. Ne comprenant pas exactement d'où vient cette erreur, je te propose le "workaround" suivant :

                Set OutMail = Nothing

                If rng.Rows.count = 2 Then Exit For ' <- ajoute cette instruction ici
            End If
NextIteration:

      Next cell

Comme je le disais : Merci ! ça ne m'a pas permis de trouvé la solution idéale mais au moins à contourner en partie le problème avant de trouver THE solution ahah
Désolée encore pour le délai de réponse.