message sur email

rebonjour
désolé pour le double post
je cherche une methode pour rejouté un message
dans l'envoi du mail
si vous avez une idée merci

la macro
rivate Sub CommandButton1_Click()
Dim Origine As Workbook
Dim PremiereFeuille As Boolean
On Error GoTo er

PremiereFeuille = True
Set Origine = ActiveWorkbook
For i = 1 To ActiveWorkbook.Sheets.Count
If ListBox1.Selected(i - 1) = True Then
If PremiereFeuille = True Then
Origine.Sheets(ListBox1.List(i - 1)).Copy
Else
Origine.Sheets(ListBox1.List(i - 1)).Copy After:=Workbooks(Application.Workbooks.Count).Sheets(Workbooks(Application.Workbooks.Count).Sheets.Count)
End If
PremiereFeuille = False
End If
Next i


ActiveWorkbook.SendMail Recipients:=TextBox1.Value, Subject:='Voici le sujet de ce mail...', ReturnReceipt:=Faste
Application.DisplayAlerts = False
ActiveWorkbook.Close ' supprime le classeur créé après l'envoi
Application.DisplayAlerts = True
ActiveWorkbook.Worksheets('ACCUEIL').Activate


Exit Sub
er:
'MsgBox err.Description
End Sub
bonne journée et Merci pour votre aide