envoie copie fichier par mail

Sub EnvoiEmail()
Dim NewBook As Workbook, Fich As String, FichTemp As String

'select source et init nom du fich avec date en [A3]
Worksheets("feuil1").Select: Worksheets("feuil1").Activate
Fich = "journée du " & Format(ActiveSheet.Range("A3"), "ddmmyy") & ".xls"

'copy toutes les cellules occupées de cette feuille
ActiveSheet.UsedRange.Copy

'cré NewBook et colle les valeurs 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
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 ("leric@wa.fr")
ActiveWorkbook.SendMail ("pascal@coco.com")
'close et supprime le fichier du disque
ActiveWorkbook.Close False
Kill FichTemp
End Sub