Sub envoi_Feuille()
Application.ScreenUpdating = False
répertoireAppli = ActiveWorkbook.Path
Nom_Fichier = répertoireAppli & "\Cross docking PHOTOBOX du " & _
Format(Worksheets("cross docking").Range("a4"), "d\-mm\-yyyy") & ".xls"
Sheets(Array("RECEPTION", "cross docking")).Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Nom_Fichier
ActiveWindow.Close
'--- Envoi par mail
Dim olapp As Object 'Outlook.Application
Sheets("destinataires email").Select
Range("A15").Select
Set olapp = CreateObject("Outlook.Application")
Do While Not IsEmpty(ActiveCell)
Dim msg As Object 'MailItem
Set msg = olapp.CreateItem(0)
msg.To = ActiveCell.Value
msg.Subject = Range("A2").Value
msg.Body = Range("A5").Value & Chr(13) & Chr(13) & Range("A6").Value & Chr(13) & Chr(13) & Range("A7").Value & Chr(13) & Chr(13) & Range("A8").Value & Chr(13) & Chr(13) & Range("A9").Value & Chr(13) & Chr(13) & Range("A12").Value & Chr(13) & Chr(13)
msg.Attachments.Add Nom_Fichier
msg.Send
ActiveCell.Offset(1, 0).Select
Loop
Set msg = Nothing
Set olapp = Nothing
Kill Nom_Fichier
Application.ScreenUpdating = True
MsgBox "Le Cross Docking a été envoyé par email avec succès ...."
End Sub