Option Explicit
Private Sub test()
Dim appOutlook As Outlook.Application, message As Outlook.MailItem
Dim email As String, MaPJ As Attachments, wb As Workbook, t As String
Dim i As Integer
Set appOutlook = CreateObject("outlook.application")
For i = 3 To Sheets.Count - 2
Sheets(i).Copy
Set wb = ActiveWorkbook
With wb
.SaveAs ThisWorkbook.Path & "\copie.xls"
t = .FullName
.Close
End With
Set message = appOutlook.CreateItem(olMailItem)
email = Sheets(i).[A1] 'destinataire
Set MaPJ = message.Attachments 'ici ça bugue au 2ème passage dans le boucle
MaPJ.Add t
With message
.Subject = "Sujet du message"
.Body = "Bonjour," & vbCr & vbCr & _
"Bla Bla Bla ....... " & vbCr & vbCr & _
"Cordialement," & vbCr & vbCr & _
"Signature."
.Recipients.Add (email)
.Send
End With
Set MaPJ = Nothing
Kill t
Next i
End Sub