Envoyer des emails en gros - Subscript out of range

Bonjour,

Je cherche à envoyer des emails en gros depuis une spreadsheet Excel via Outlook. Ma spreadsheet est nommée "EMAIL" avec les adresses email en A, prénom B, nom de famille en C, sujet de l'email to send en D, corps en E, attachement (files path) en F, date en G, et le statut (envoyé/en cours) en H.

Lors de l'exécution du script, j'obtiens ce message d'erreur:

"Run time error 9, subscript out of range"

Avec le debugging qui indique une erreur en ligne 3. Voici mon code:

Sub send_email()
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Sheets("EMAIL")

    Dim OA As Object
    Dim msg As Object

    Set OA = CreateObject("Outlook.Application")
    Dim each_row As Integer
    Dim last_row As Integer
    last_row = Application.WorksheetFunction.CountA(sh.Range("A:A"))

    For each_row = 2 To last_row
          Set msg = OA.createitem(0)
          msg.To = sh.Range("A" & each_row).Value
          first_name = sh.Range("B" & each_row).Value
          last_name = sh.Range("C" & each_row).Value
          msg.cc = sh.Range("D" & each_row).Value
          msg.Subject = sh.Range("E" & each_row).Value
          msg.body = sh.Range("F" & each_row).Value
          date_to_send = sh.Range("H" & each_row).Value
          date_to_send = Format(date_to_send, "dd/mm/yyyy")
          Status = sh.Range("I" & each_row).Value
          current_date = Format(Date, "dd/mm/yyyy")
          If date_to_send = current_date Then
                If sh.Range("G" & each_row).Value <> "" Then
                msg.attachments.Add sh.Range("G" & each_row).Value
                Cells(each_row, 9).Value = "Sent"
                Content = Replace(msg.body, "<>", first_name + " " + last_name)
                msg.body = Content
                msg.send
            Else
                Cells(each_row, 9).Value = "Sent"
                Content = Replace(msg.body, "<>", first_name + " " + last_name)
                msg.body = Content
                msg.send
            End If
          End If

    Next each_row
End Sub

Merci pour votre aide.

Bonjour andre_ange_marcel,

vérifie que le nom de la feuille est EMAIL sans espaces avant ou après le nom. De plus les lettres dans ton code ne correspondent pas à la colonne avec les données, par exemple tu écris date en G et tu as dans le code

date_to_send = sh.Range("H" & each_row).Value

Merci beaucoup pour cette réponse.
Ma macro était enregistrée dans le mauvais workbook. J'ai effectivement remarqué plus tard que mes données n'étaient pas en place. Maintenant tout fonctionne. Merci pour la réponse!

Bonjour,

Merci du retour et de passer le sujet en résolu.

Cordialement.