Sub envoi_Feuille()
répertoireAppli = ActiveWorkbook.Path ' Penser à Outils/Références/Outlook à rajouter
Sheets("BL").Copy ' crée un classeur avec la feuille résultats
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs répertoireAppli & "\" & Feuil2.[E2].Value & ".xls"
ActiveWindow.Close
'--- Envoi par mail
Dim olapp As Outlook.Application
Sheets("MAIL et Base").Select
Range("E11").Select
Do While Not IsEmpty(ActiveCell)
Dim msg As MailItem
Set olapp = New Outlook.Application
Set msg = olapp.CreateItem(olMailItem)
msg.To = ActiveCell.Value
msg.Subject = Range("E2").Value
msg.Body = Range("E5").Value & Chr(13) & Chr(13) & Range("E8").Value & Chr(13) & Chr(13)
msg.Attachments.Add Source:=répertoireAppli & "\" & Feuil2.[E2].Value & ".xls"
msg.Send
ActiveCell.Offset(1, 0).Select
Loop
End Sub