Envoyer une feuille excel en pièce jointe avec destinataires différents

Sub Mail_Sheets()
'Working in 97-2010
    Dim wb As Workbook
    Dim Shname As Variant
    Dim Addr As Variant
    Dim N As Integer
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim I As Long

    Shname = Array("P-Jean-Jacques", "JoeBloe")
    adr1 = Sheets("P-Jean-Jacques").Cells(12, 1)
    adr2 = Sheets("JoeBloe").Cells(12, 1)
    Addr = Array(adr1, adr2)

    If Val(Application.Version) >= 12 Then
        'You run Excel 2007-2010
        FileExtStr = ".xlsm": FileFormatNum = 52
    Else
        'You run Excel 97-2003
        FileExtStr = ".xls": FileFormatNum = -4143
    End If

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    TempFilePath = Environ$("temp") & "\"

    'Create the new workbooks/Mail it/Delete it
    For N = LBound(Shname) To UBound(Shname)

        TempFileName = "Sheet " & Shname(N) & " " & Format(Now, "dd-mmm-yy h-mm-ss")

        ThisWorkbook.Sheets(Shname(N)).Copy
        Set wb = ActiveWorkbook

        With wb
            .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormatNum
            On Error Resume Next
            For I = 1 To 3
                .SendMail Addr(N), _
                          "This is the Subject line"
                If Err.Number = 0 Then Exit For
            Next I
            On Error GoTo 0
            .Close SaveChanges:=False
        End With

        'Delete the file you have send
        Kill TempFilePath & TempFileName & FileExtStr

    Next N

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Sub envoiMailEtFeuilleActive()
    Application.ScreenUpdating = False
    For sh = 1 To Sheets.Count
        Sheets(sh).Select
        ActiveSheet.Copy    ' crée une copie de la feuille active
        ActiveWorkbook.SendMail Recipients:=ActiveSheet.Range("a12").Value, Subject:="envoi du :" & Date & Time    'envoi Mail
        Application.DisplayAlerts = False
        ActiveWorkbook.Close    ' supprime le classeur créé après l'envoi
        Application.DisplayAlerts = True
    Next
    Application.ScreenUpdating = True
End Sub