'Séparer les paramètres messagerie et les données à envoyer dans deux feuilles différentes !
'la macro tourne avec les noms ci-dessous :
'------------------------------------------
'1' Nommer la feuille avec les données à envoyer "Donnees"
'2' Nommer la feuille avec les paramètres messagerie "ParamEmail"
'3' Nommer les Cellules avec les paramètres messagerie comme suit :
'la date > CellDate . . . pour le nom du fichier (vous pouvez changer ceci dans le code !?)
'le sujet > CellSujet . . . le sujet du message
'adresses > CellAdresDestin . . . si plusieurs adresses séparer par ; (si marche pas essayer avec ,)
Sub EnvoiEmail()
Dim NewBook As Workbook, Fich$, FichTemp$, Sujet$, AdresDestin$
'select feuille avec paramètres Email et init var messagerie
Sheets("ParamEmail").Select
'nom du fich qui sera celui de la date placée en [CellAdate] EXP: "Journée du 01012010.xls"
Fich = "Journée du " & Format(Range("CellDate"), "ddmmyy") & ".xls"
Sujet = Range("CellSujet")
AdresDestin = Range("CellAdresDestin")
'select feuille avec données à envoyer et copy toutes les cellules occupées dans cette feuille
Sheets("Donnees").Select: Sheets("Donnees").Activate
ActiveSheet.UsedRange.Copy
'cré NewBook et COLLE LES VALEURS SEULEMENT avec formats
Set NewBook = Workbooks.Add
NewBook.Sheets(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.FormatConditions.Delete
Selection.Hyperlinks.Delete
Application.CutCopyMode = False
NewBook.Sheets(1).Range("A1").Select
'save et load le chemin complet pour suppr après
Application.DisplayAlerts = False
NewBook.SaveAs Filename:=Fich, FileFormat:=xlWorkbookNormal
FichTemp = ActiveWorkbook.FullName
Application.DisplayAlerts = True
'envoi
ActiveWorkbook.SendMail Recipients:=AdresDestin, Subject:=Sujet, ReturnReceipt:=True
'close et supprime le fichier du disque
ActiveWorkbook.Close False
Kill FichTemp
'fin retour feuille param
Sheets("ParamEmail").Select: Range("A1").Select
End Sub