Yardım Seçili Alanı Mail İle Göndermek // Lütfen Yardımcı Olur Musunuz?

Merhaba,

Yaptığım iş nedeniyle her saat başı 3 farklı rapor göndermek zorundayım.

Bu raporları bir program üzerinden çekip, excelde birleştirerek paylaşımını 3 farklı gruba sağlıyorum.

Bu 3 farklı mail için;

1. Mailde ilgili sayfada ki seçili alanı kopyalayıp, mail bodysine özel yapıştırdan bit eşlem olarak yapıştırarak göndermesi,

2. Mailde yine ilgili sayfada ki seçili alanı kopyalayıp, mail bodysine yapıştırarak göndermesi,

3. mailde de hem sayfanın içeriğindeki sadece seçili alanı copyalayıp mail bodysine yapıştırması & ilgili sayfayı taşı kopyala yaparak mail'e ek olarak eklemesini istiyorum.

1 ve 2. mailler için aşağıdakileri denedim ama bi türlü istediğim sonuca ulaşamadım.

Burda yaşadığım sorunlar;

1. mail için seçili alanı kopyalatamadım tüm sayfayı kopyalıyor ve bit eşlem yapıştırmasını sağlayamadım.
2. Mail için seçili alanı kopyalatamadım tüm sayfayı kopyalıyor ve yapıştırdığı puntosunu büyütüyor.
3. mailde seçili alanı kopyalatamadım ve ilgili sayfanın bir ekini ek olarak ekleyemedim.


Rica etsem bu konularda bana destek olabilir misiniz?


----------------------------------------------------------------------------------------------------
Sub Email_Gonder()
Dim Makro As Object, Mail As Object
Set Makro = CreateObject("Outlook.Application")
Set Mail = Makro.CreateItem(0)
Dim rng As Range
Set rng = Nothing
Set rng = Sheets(13).Range("B1:AB56")



With Mail
.To = "MeteKaan.Asut@arvatocrmturkey.com"
.CC = "MeteKaan.Asut@arvatocrmturkey.com"
.Subject = "DENEME"
.HTMLBody = RangetoHTML(rng)

.Display
End With
On Error GoTo 0
Set Mail = Nothing: Set Makro = Nothing

----------------------------------------------------------------------------------------------------

Sub Aktif_Sayfayi_Mesaj_Govdesi_Olarak_Gonder()

Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Set rng = Nothing
Set rng = ActiveSheet.UsedRange

Set rng = Sheets("UzSD").UsedRange

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = ""
.HTMLBody = RangetoHTML(rng)
.Display
End With
On Error GoTo 0

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

Set OutMail = Nothing: Set OutApp = Nothing
End Sub
----------------------------------------------------------------------------------------------------