Envoi fichier à plusieurs destinataire

Bonjour à tous,

Malgré plusieurs recherches infructueuses, je me tourne vers vous pour me venir en aide.

Dans le fichier ci-joint, en choisissant un numéro différents en A10 sur l'onglet pilotage, mes données s'actualise en fonction de se numéro. Ce que je souhaiterai, c'est d'envoyer via une macro l'onglet pilotage à tout les destinataires se trouvant dans l'onglet "Liste", en tenant compte du numéro en A10, afin ce que le destinataire reçoive les informations le concernant.

J’espère avoir été clair.

Je suis à votre disposition pour toutes questions.

Merci à vous et bon weekend.

Bonjour,

voulez-vous faire un seul envoi au groupe de destinataires, ou un envoi identique, séparément à chacun d'eux ?

Salut sabV,

Je souhaiterai un envoi identique séparément à chacun d'eux.

Merci à toi

Bonjour,

envoyer via une macro l'onglet pilotage

est que l'onglet pilotage doit être mit comme fichier attaché ou bien comme tableau dans le message ?

Re,

En pièce jointe

Bonjour,

à tester,

Sub EnvoiMail()
Dim sh1, sh2, nb As Integer, m As Integer, n As Integer, i As Integer
Dim sTO As String, sObjet As String, sMessage As String, sFichier As String
Set sh1 = Sheets("Pilotage")
Set sh2 = Sheets("liste")
chemin = ThisWorkbook.Path
sFichier = chemin & "\" & sh1.[A10] & " - " & sh1.[D5] & " - " & Format(Right(sh1.[J3], 10), " dd-mm-yyyy")
'Sheets("Pilotage").ExportAsFixedFormat Type:=xlTypePDF, Filename:=sFichier, _
'  Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

nb = Application.CountIf(sh2.Range("A:A"), sh1.Range("A10").Value)
n = 1
m = 0
For i = 1 To nb
 m = Application.Match(sh1.[A10], sh2.Range("A" & n & ":A65000"), 0) + m

    sTO = sh2.Range("C" & m)
    sObjet = "RETARDS ET ECHEANCES DE PAIEMENT"
    sMessage = "RETARDS ET ECHEANCES DE PAIEMENT"
    Envoyer_Mail_Outlook sTO, sObjet, sMessage, sFichier
 n = m + 1
Next
End Sub

Function Envoyer_Mail_Outlook(destTO As String, objet As String, message As String, fichier As String)
'Nécessite d'activer la référence "Microsoft Outlook Library"
Dim ObjOutlook As New Outlook.Application
Dim oBjMail
Dim Nom_Fichier As String

    Set ObjOutlook = New Outlook.Application
    Set oBjMail = ObjOutlook.CreateItem(olMailItem)

   Nom_Fichier = fich
    If objet = "" Then Exit Function
     With oBjMail
       .To = destTO
       .Subject = objet
       .Body = message
       .Attachment.Add fichier
       .Display    'vérification avant d'envoyer
'       .Send      'envoi du message
    End With

    Set oBjMail = Nothing
    Set ObjOutlook = Nothing
End Function

Re,

En ajoutant le lien pour aller récupérer le fichier, cela fonctionne. Par contre, cela ne me sort que le mail du numéro sélectionné en A10 sur l'onglet "Pilotage".

Je souhaiterai que lorsque je lance la macro, cela me sorte un mail par chaque numéro présent dans l'onglet "Liste".

En gros, là je devrais avoir 5 mails. Un par personne avec ces données sur l'onglet "pilotage" en fonction de son numéro présent en A10.

J’espère avoir été clair.

Merci à toi du temps déjà passé.

Bonjour,

ok, voici la modification de la macro EnvoiMail:

Sub EnvoiMail()
Dim sh1, sh2, nb As Integer, m As Integer, n As Integer, i As Integer
Dim sTO As String, sObjet As String, sMessage As String, sFichier As String
Set sh1 = Sheets("Pilotage")
Set sh2 = Sheets("liste")
chemin = ThisWorkbook.Path
LastRw = sh2.Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To LastRw
 If sh2.Range("C" & i) <> "" Then
    sh1.Range("A10").Value = sh2.Range("A" & i).Value

    sFichier = chemin & "\" & sh1.[A10] & " - " & sh1.[D5] & " - " & Format(Right(sh1.[J3], 10), " dd-mm-yyyy")

    sh1.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sFichier, Quality:=xlQualityStandard, _
      IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

    sTO = sh2.Range("C" & m)
    sObjet = "RETARDS ET ECHEANCES DE PAIEMENT"
    sMessage = "RETARDS ET ECHEANCES DE PAIEMENT"
    Envoyer_Mail_Outlook sTO, sObjet, sMessage, sFichier
 End If
Next
End Sub

Bonjour,

La macro s'arrête à cette ligne ...

As-tu une idée ?

Sub EnvoiMail()
Dim sh1, sh2, nb As Integer, m As Integer, n As Integer, i As Integer
Dim sTO As String, sObjet As String, sMessage As String, sFichier As String
Set sh1 = Sheets("Pilotage")
Set sh2 = Sheets("liste")
chemin = ThisWorkbook.Path
LastRw = sh2.Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To LastRw
 If sh2.Range("C" & i) <> "" Then
    sh1.Range("A10").Value = sh2.Range("A" & i).Value

    sFichier = chemin & "\" & sh1.[A10] & " - " & sh1.[D5] & " - " & Format(Right(sh1.[J3], 10), " dd-mm-yyyy")

    sh1.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sFichier, Quality:=xlQualityStandard, _
      IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

   sTO = sh2.Range("C" & m)
    sObjet = "RETARDS ET ECHEANCES DE PAIEMENT"
    sMessage = "RETARDS ET ECHEANCES DE PAIEMENT"
    Envoyer_Mail_Outlook sTO, sObjet, sMessage, sFichier
 End If
Next
End Sub

correction, remplacer:

sTO = sh2.Range("C" & m)

par

sTO = sh2.Range("C" & i)

MERCI MERCI ET MERCI.

C'est parfait ! C'est pile ce que je souhaitait !

Bonne continuation à toi et à bientot sur le forum