Sub envoiPJ_Fichier()
Dim olapp As Outlook.Application
Sheets("destinataires").Select
Range("A11").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("A2").Value
msg.Body = ActiveCell.Offset(0, 1).Value & " " & ActiveCell.Offset(0, 2).Value & " " & ActiveCell.Offset(0, 3).Value & Chr(13) & Chr(13) & ActiveCell.Offset(0, 4).Value & Chr(13) & Range("A5").Value & Chr(13) & Chr(13) & ActiveCell.Offset(0, 5).Value & Chr(13) & Range("A8").Value
'-- pj
ActiveCell.Offset(0, 6).Select
Do While Not IsEmpty(ActiveCell)
' nf = ActiveWorkbook.Path & "\" & ActiveCell.Value
' msg.Attachments.Add Source:=nf
ActiveCell.Offset(0, 1).Select
Loop
msg.Display
[COLOR=red][B]Cells(ActiveCell.Row + 1, 1).Select[/B][/COLOR]
Loop
End Sub