Sub Mail()
Dim olApp As Object, M As Object, Chemin As String, Wbk As Workbook
Dim NomFeuille As String
Chemin = Environ$("temp")
Set olApp = CreateObject("Outlook.application")
Set M = olApp.CreateItem(olMailItem)
NomFeuille = ActiveSheet.Name
On Error Resume Next
Kill Chemin & "\temp.xlsx"
On Error GoTo 0
Set Wbk = Workbooks.Add(1)
ThisWorkbook.Sheets(NomFeuille).[A1:K49].Copy
Wbk.Sheets(1).Paste
Wbk.SaveAs Chemin & "\temp"
Wbk.Close
With M
.Subject = "Navette"
.Body = "Bonjour, veuillez trouver ci joint la navette, à remplir et à nous renvoyer. Vous remerciant par avance."
.Recipients.Add [E5]
.attachments.Add Chemin & "\temp.xlsx"
.Send
End With
End Sub