Uygulama Belirtilen Hücre Aralığını Boş Kitap İçinde Mail'e Ek Yapmak

Sub Belirlene_Hucre_Araligini_Kitap_Olarak_Ekle()
    Dim Source As Range, Dest As Workbook, wb As Workbook
    Dim TempFilePath$, TempFileName$, FileExtStr$
    Dim FileFormatNum&, I As Long
    Range("A1:D11").Select
    Set Source = Nothing
    On Error Resume Next
    Set Source = Selection.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    If Source Is Nothing Then
        MsgBox "Kaynak bir aralık değildir veya sayfa korunur" & ", lütfen düzeltin ve tekrar deneyin.", vbOKOnly
        Exit Sub
    End If
   If ActiveWindow.SelectedSheets.Count > 1 Or _
       Selection.Cells.Count = 1 Or _
       Selection.Areas.Count > 1 Then
        MsgBox "Bir hata oluştu:" & vbNewLine & vbNewLine & _
               "Seçim yapmadınız, hücre aralığını seçin.", vbOKOnly, "Www.ExcelTurkey.Com"
        Exit Sub
    End If
  With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    Set wb = ActiveWorkbook
    Set Dest = Workbooks.Add(xlWBATWorksheet)
    Source.Copy
    With Dest.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial Paste:=xlPasteValues
        .Cells(1).PasteSpecial Paste:=xlPasteFormats
        .Cells(1).Select
        Application.CutCopyMode = False
    End With
    TempFilePath = Environ$("temp") & "\"
    TempFileName = wb.Name & " " & Format(Now, "dd-mm-yyyy   h-mm-ss")
    If Val(Application.Version) < 12 Then
        'Excel 2000-2003
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        'Excel 2007-2016
        FileExtStr = ".xlsx": FileFormatNum = 51
    End If
    With Dest
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        For I = 1 To 3
            .SendMail "", "Buraya Konuyu Yazın !!!"
            If Err.Number = 0 Then Exit For
        Next I
        On Error GoTo 0
        .Close savechanges:=False
    End With
    Kill TempFilePath & TempFileName & FileExtStr
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub