Créer une feuil excelle selon la valeur d'une cellule

Hello,

Je n'ai vraiment pas réussi a trouver une solution

Please HELP ...

J'ai réussi à faire correctement la pièce jointe dans le mail

Par contre destinataire : adresse principale et pour copie que dois je mettre ?

Pour le corps du mail "Texte" comment l’inclure ... car la il se met dans objet du mail

Merci

Bonjour,

voici la modification,

Sub test_mail2()
'Il faut activer la référence "Microsoft Outlook Library" Avant de lancer cette macro
Dim ObjOutlook As New Outlook.Application
Dim oBjMail
Dim Nom_Fichier As String

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

Set sh1 = Sheets("Planning")
Set sh2 = Sheets("mail")

lastRow = sh1.Cells(Rows.Count, "A").End(xlUp).Row + 1
n = 1
deb = 3
sh2.Activate

 For i = 4 To lastRow
  n = n + 1
  If sh1.Cells(i, "C").Value <> sh1.Cells(deb, "C").Value Then

    sh2.Range(sh2.Cells(3, "A").Address, sh2.Cells(n + 1, "BG").Address).Value = sh1.Range(sh1.Cells(deb, "B").Address, sh1.Cells(i - 1, "BG").Address).Value
    destina = Evaluate("MATCH(B3,adresseMail!A:A,0)")
    destinataire1 = Sheets("adresseMail").Cells(2, destina)
    destinataire2 = Sheets("adresseMail").Cells(3, destina)
    destinataire3 = Sheets("adresseMail").Cells(4, destina)
    deb = i

    sh2.Copy
    chemin = "C:\Users\hamilaha\Desktop\"
    fichier = chemin & Range("B3") & ".xlsx"
    ActiveWorkbook.SaveAs Filename:=fichier, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

     With oBjMail
        .To = destinataire1
        .CC = destinataire2 & ";" & destinataire2
        .BCC = ""
        .Subject = "programme de la semaine prochaine"
        .Body = "Bonjour, ci-joint le programme de la semaine prochaine"
        .Attachments.Add (fichier)
'       .Display  '   vérification avant d'envoyer (pour un test en pas à pas)
       .Send      'envoi du message
    End With

    ActiveWorkbook.Close SaveChanges:=False
    sh2.Range("A3:GD" & sh2.Cells(Rows.Count, "B").End(xlUp).Row).ClearContents

    n = 1
  End If
 Next

Set oBjMail = Nothing
Set ObjOutlook = Nothing
End Sub

Bonjour SabV,

Franchement ... je ne sais pas quoi dire si tu n'étais pas là !!

Enfin, ça fonctionne parfaitement ... siam ... ... je ne veux pas le dire, ... désolé ... il y a un petit bemol

Dans le résultat j'ai bien : mail destinataire principale mais en copie la même adresse se présente 2 fois

Mon objectif est de mettre l'adresse de la colonne C et D en copie ... donc j'ai tanté les modifications ... et ca ne fonctionne pas :'(

Honnêtement, je bidouille mais, je risque de casser la macro ... donc je préféré avoir quelques explique ou un coup de pousse !

Voir image ci-jointe

Mes sincères remerciement SabV

oups, mea culpa, j'ai inversé ligne et colonne,

voici la correction,

    destina = Evaluate("MATCH(B3,adresseMail!A:A,0)")
    destinataire1 = Sheets("adresseMail").Cells(destina, 2)
    destinataire2 = Sheets("adresseMail").Cells(destina, 3)
    destinataire3 = Sheets("adresseMail").Cells(destina, 4)

Hello,

pas de soucis ... ca je l'ai vu mais même en changeant ...j'ai le message d'erreur que je t'ai posté Ajd

En faite la macro envoie le 1 mail et elle s' arret à la création de la 2 feuil Excel ... elle ne crée pas le mail ...

Dans l'attente de ton retour

MERCI

j'ai fait le test avec la correction et je n'ai pas de message d'erreur,

et ton image est trop flou je ne voie pas le message d'erreur.

j'ai trouvé !!

Pas tt seul bien sure

voilà la modif :

Set oBjMail = ObjOutlook.CreateItem(olMailItem) --> Supprimée

With oBjMail --> remplacé par : With ObjOutlook.CreateItem(olMailItem)

Grand Merci à toi SabV et je pense @ très vite

Ciao et bon weekend !