Selected Range , send as mail

[Keoxes]

Hi,
I have columns on "healthcheck" sheet that gets updated daily, with the latest update on the last blank column. I am then trying to locate the last filled column and copy paste it to a separate sheet "export" so that I can select the range and have it go out as part of an email.

But for some reason my rPort variable returns just "true" as part of the mail body.
&
the From function breaks the code

Where have I gone wrong?

Sub Macro1()

Sheets("HealthCheck").Select 'Reselect page


Range("A1").Select
    Selection.End(xlToRight).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Export").Select
    Range("B1").Select
    ActiveSheet.Paste
   rPort = ActiveSheet.Range("A1:B4").Select 'range selection on Export sheet




Dim tDate As String
Dim OutApp As Object
Dim OutMail As Object




tDate = Format(DateTime.Now, "dd mmmm yyyy hh:mm") 'Format Today's date for filename
Application.ScreenUpdating = True 'Turn on screenupdating


Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
    With OutMail
    .Display
    End With
        Signature = OutMail.Body
    With OutMail
    '.From = "me@me.com"
    .To = "you@you.com"
    .Subject = " HealthCheck Report " & tDate
    .HTMLBody = "<p class=MsoNormal> <Span style='font-size:11.0pt'>Hi  , <br><br>Platform HealthCheck report:" & rPort & " </Span></p> " & .HTMLBody
    MsgBox ("Your HealthCheck Report is now ready to be sent to OPS.") 'Display a message box outlining end of script


End With


Set OutMail = Nothing
Set OutApp = Nothing


End Sub

 

[Logit]

.
This macro/s will copy the last used column in Sheet1, paste to first column in Sheet2. Then copies that data to be inserted into the email.
Sheet2 is cleared of all data in preparation for the next use.

You will need to change the sheet names to match for your project.

Option Explicit




Sub mailTableWithGridLines()
Dim OutApp As Object
Dim OutMail As Object
Dim vInspector, GetInspector, wEditor As Variant
Dim lastRow As Long


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


With OutMail
    .To = "yo momma@nowhere.com"
    .CC = "xyz@anc.com"
    .BCC = "abc@xyz.com"
    .Subject = "Test"
    .Body = "Dear " & "Macro " & vbCrLf
    .Display
    Sheets("Sheet2").Activate
    Sheets("Sheet2").Select
    Sheets("Sheet2").UsedRange.Copy
    Set vInspector = OutMail.GetInspector
    Set wEditor = vInspector.WordEditor


    wEditor.Application.Selection.Start = Len(.Body)
    wEditor.Application.Selection.End = wEditor.Application.Selection.Start


    wEditor.Application.Selection.Paste


'.Display
End With
Sheets("Sheet2").UsedRange.Clear
Application.CutCopyMode = False
Sheets("Sheet2").Range("A1").Select
    Sheets("Sheet1").Activate
    Range("A1").Select
End Sub


Sub Sample()
    Dim ws As Worksheet
    Dim rng As Range
    Dim LastCol As Long
    Dim LastColumn As String


    Set ws = ThisWorkbook.Sheets("Sheet1")


    With ws
        LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column


        '~~> Return column name from number
        LastColumn = Split(.Cells(, LastCol).Address, "$")(1)


        Set rng = .Range(LastColumn & "1")
        rng.EntireColumn.Copy Sheets("Sheet2").Range("A1")
        
    End With
    mailTableWithGridLines
End Sub

Download sample workbook here : https://www.amazon.com/clouddrive/share/3NrH7E73umNvWpCci7qBV9WIrZ0zLGYHD8IcuOAvXyz