Microsoft 365 Déclenchement macro en série suite à cellule fusionnées

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Intersect(Columns(17), Target) Is Nothing Then Exit Sub
    
    Target = Date 'Format(Now, "hh:mm")
    Cancel = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    c = ActiveCell
    Set R = Intersect(Target, Columns(17))
    If Not R Is Nothing Then
        'For Each cell In R '<<< boucle
            If IsDate(c) Then
                mail
            End If
        'Next cell
    End If
End Sub

Sub mail()
Dim c As Range
Dim OutlookApp As Object
Dim OutlookMail As Object
Dim Signature As String
Dim CorpsDuMessage As String
Dim Texte As String
Dim Rep As Integer

    If MsgBox("Voulez-vous envoyer le mail ?", vbYesNo + vbQuestion, "Mail d'alerte") = vbNo Then Exit Sub
    
    ' Créer une instance d'Outlook
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
    
    ' Afficher l'e-mail pour récupérer la signature par défaut
    With OutlookMail
        .Display
        Signature = .HtmlBody
    End With
    
    Set c = ActiveCell
    Num = c.Offset(0, -16).Value
    Dest = c.Offset(0, -9).Value
    
    Select Case Dest
        Case "JOE"
            LD1 = "Joe.Dalton@hotmail.fr"
        Case "JACK"
            LD1 = "Jack.Dalton@hotmail.fr"
        Case "WILLIAM"
            LD1 = "William.Dalton@hotmail.fr"
        Case "AVREL"
            LD1 = "Avrel.Dalton@hotmail.fr"
    End Select
    
    'If c.Offset(0, -9).Value Like "*HUP*" Then
    'LD1 = "audrey.hupenoire@sncf.fr"
    'End If
    
    ' Construire le corps du message
    Texte = Texte & "<p>Bonjour,</p>"
    Texte = Texte & "<p>Vous allez envoyer un mail ! <br> </p>"
    Texte = Texte & "<p>Bonne journée, <br> </p>"
    Texte = Texte & "Cordialement"
    
    ' Ajouter le corps du message et la signature
    With OutlookMail
        .To = LD1 & LD2 & LD3 & LD4 & LD5
        .Cc = ""
        .Subject = "#Mail pour la semaine n°" & " " & Num
        .HtmlBody = Texte & Signature
        .Display ' Utilisez .Send pour envoyer directement l'e-mail
        .Importance = 2 ' Niveau d'importance du mail
    End With
    
    ' Nettoyer les objets
    Set OutlookMail = Nothing
    Set OutlookApp = Nothing
End Sub