Sub Mail_Text_in_Body()
Dim msg As String, cell As Range
Dim Recipient As String, Subj As String, HLink As
String
Dim Recipientcc As String, Recipientbcc As String

Recipient = ""
Recipientcc = ""
Recipientbcc = ""
'Subj = "test"

msg = Sheets("PIVNUMS").Range("A18").Value & " - Piv
#s "
lastRow = Sheets("PIVNUMS").Range("B65536").End(xlup).Row
For Each cell In Sheets("PIVNUMS").Range("B" & lastRow & ":AG" &
lastRow)
msg = msg & cell
Next cell
msg = WorksheetFunction.Substitute(msg, vbNewLine, "%
0D%0A")

HLink = "mailto:" & Recipient & "?" & "subject=" &
msg & "&"
'HLink = HLink & "subject=" & Subj & "&"
HLink = HLink & "body=" & msg

ActiveWorkbook.FollowHyperlink (HLink)
'Application.Wait (Now + TimeValue("0:00:03"))
'Application.SendKeys "%s"
End Sub

"alldreams" wrote in message
...
This is the code to take a cell range and pastes it in an
email's subject line and body. The flaw is that I will
have manually update the cell range to get the last
filled row

I like to select a wider cell range so the macro would
paste the last filled rowin that range. Any suggestionse
will be greatly appreciated.

Sub Mail_Text_in_Body()
Dim msg As String, cell As Range
Dim Recipient As String, Subj As String, HLink As
String
Dim Recipientcc As String, Recipientbcc As String

Recipient = ""
Recipientcc = ""
Recipientbcc = ""
'Subj = "test"

msg = Sheets("PIVNUMS").Range("A18").Value & " - Piv
#s "
For Each cell In Sheets("PIVNUMS").Range("B18:AG18")
msg = msg & cell
Next cell
msg = WorksheetFunction.Substitute(msg, vbNewLine, "%
0D%0A")

HLink = "mailto:" & Recipient & "?" & "subject=" &
msg & "&"
'HLink = HLink & "subject=" & Subj & "&"
HLink = HLink & "body=" & msg

ActiveWorkbook.FollowHyperlink (HLink)
'Application.Wait (Now + TimeValue("0:00:03"))
'Application.SendKeys "%s"
End Sub