E-Mail gönderim yardımı

[Mehmet Sait]

Merhabalar,

Ekli kod yardımı ile belli bir tabloyu mail yollayabiliyorum. Bu tabloya ek olarak mail gönderirken, AJ126:BA128 aralığında bulunan tabloyu da 2. sayfa olarak eklemek mümkün mü ?
Kodlarda nasıl bir düzenleme yapılmalı?

Yardımlarınız için teşekkür ederim.

Sub MailGonder()

  Dim K1 As Workbook, S1 As Worksheet, Yol As String, Dosya_Adi As String
    Dim Onay As Byte, Uygulama As Object, Yeni_Mail As Object
      
 
  Application.ScreenUpdating = False
    
    Range("$B$3:$W$97").Select
    ActiveSheet.PageSetup.Orientation = xlPortrait
    ActiveSheet.PageSetup.PrintArea = "$B$3:$V$97"
    
    
    Onay = MsgBox("Kayıt edip mail göndermek istiyor musunuz?", vbExclamation + vbYesNo, "")
    If Onay = vbNo Then
        MsgBox "İşleminiz iptal edilmiştir.", vbInformation, ""
        Exit Sub
    End If
      
    Set K1 = ThisWorkbook
    Set S1 = K1.Sheets(Range("D1").Text)
      
      
      
    Yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & _
          Application.PathSeparator & Year(Date) & " Üretim Vardiya Raporları"
    If Dir(Yol, vbDirectory) = "" Then MkDir (Yol)

    Yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & _
          Application.PathSeparator & Year(Date) & " Üretim Vardiya Raporları" & Application.PathSeparator & Format(Date, "mmmm yyyy") & " - Üretim Vardiya Raporları"
    If Dir(Yol, vbDirectory) = "" Then MkDir (Yol)

    On Error Resume Next
    Set Uygulama = GetObject(, "Outlook.Application")
    On Error GoTo 0
  
    'If Uygulama Is Nothing Then Call Shell("Outlook.exe", vbHide)
  
    Set Uygulama = CreateObject("Outlook.Application")
    Set Yeni_Mail = Uygulama.CreateItem(0)
  
    Dosya_Adi = S1.Range("G3").Value & " " & S1.Range("G5").Value & ".pdf"

    S1.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=Yol & "\" & Dosya_Adi, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False

    With Yeni_Mail
        '.Display
        .To = S1.Range("Z3").Value
        .CC = S1.Range("Z4").Value
        .BCC = S1.Range("Z5").Value
        .Subject = S1.Range("G3").Value & " " & S1.Range("G5").Value
        '.Body = S1.Range("Z6").Value
        .Attachments.Add Yol & Application.PathSeparator & Dosya_Adi
        .BodyFormat = 2
        .Save
        .Send
    End With
  
   MsgBox "E-mail gönderilmiştir.", vbInformation, ""
  
    S1.PageSetup.PrintArea = "$B$3:$V$97"
    S1.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
  
    Set K1 = Nothing
    Set S1 = Nothing
    Set Yeni_Mail = Nothing
    Set Uygulama = Nothing

    
End Sub