Soru Sayfadaki farklı hücreleri birleştirerek makro ile mail gönderme.

[efekaanack]

Merhabalar, excel'de belirlenen hücreleri vba makroyla mail olarak gönderme kodunu yazdım. Bu kodda A7 ile N25 sütunları arasındaki satır ve sütunlar gönderiliyor. Buna ek olarak A1 ve N4 arasındaki kodları da eklemek istiyorum yani 2 farklı hücreyi birleştirip o şekilde mail göndermek istiyorum. Alttaki kod hazır ve doğru.

Spoyler: Kod

Sub mailsayfa_hucre()

Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next

Set rng = Sheets("sayfa").Range("A7:N25").SpecialCells(xlCellTypeVisible)

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

With OutMail
.to = "hedef@mail.com"
.cc = ""
.bcc = ""
.Subject = "YAKIT FARKI1 sayfa"
.BODY = "Merhaba, Yakıt farkı dosyası ektedir."
.HTMLBody = RangetoHTML(rng)
.send

End With
On Error GoTo 0

With Application
.EnableEvents = True
.ScreenUpdating = True

End With

End Sub

Function RangetoHTML(rng As Range)

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook

TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy") & ".htm"

rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
On Error GoTo 0
End With

With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With

Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.ReadAll
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")

TempWB.Close SaveChanges:=False

Kill TempFile

Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing

End Function

Mail çıktısının bu şekilde olmasını istiyorum.

A1+N4
A7+N25

Bu şekilde taradığım bölgeleri birleştirmek istiyorum.

 

[mukoli]

Merhaba
Burdaki { Set rng = Sheets("sayfa").Range("A7:N25").SpecialCells(xlCellTypeVisible) }Kodu aşagıdaki kodla denermisin.
Set rng = Sheets("sayfa").Range("A1:N4", "A7:N25").SpecialCells(xlCellTypeVisible)

 

[efekaanack]

Yanıtınız için teşekkür ederim farklı bir şekilde hallettim.

Dim rng As Range > Dim rng As Range, rng1 As Range yaptım

Set rng = Sheets("HAYMANA").Range("A4:N35").SpecialCells(xlCellTypeVisible)
Set rng1 = Sheets("HAYMANA").Range("A36:N65").SpecialCells(xlCellTypeVisible) bunu ekledim

ve son olarak da

.HTMLBody = RangetoHTML(rng) & RangetoHTML(rng1) altı çiziliyi ekledim