Send email from cell range in Sheet2 and copy all data to last row

[Patriot2879]

HI All, good morning, i have this code below which works but at the moment it sends the email from the cells in active sheet, and i want it to send the emails from my range in sheet 2 for example the .To i want to send from sheet 2 and B1, and at the moment i have named my range to screenshot and send for example D12:N31 but i want it to be D12:N and to the last row as data gets added daily, can you help me please with this.

Sub SendHTML_And_Image_As_Body_UsingOutlook()

    Dim olApp As Object
    Dim NewMail As Object
    Dim ChartName As String
    Dim imgPath As String
    
    On Error GoTo err
    
    If [toEmail] = "" Then
        MsgBox "ToEmail ID is mandatory"
        Exit Sub
    End If
    
    Set olApp = CreateObject("Outlook.Application")
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    

    tmpImageName = VBA.Environ$("temp") & "\tempo.jpg"
    

    Set RangeToSend = ActiveSheet.Range("D12:N31")

    RangeToSend.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    

    
    Set sht = Sheets.Add
    sht.Shapes.AddChart
    sht.Shapes.Item(1).Select
    Set objChart = ActiveChart

    With objChart
        .ChartArea.Height = RangeToSend.Height
        .ChartArea.Width = RangeToSend.Width
        .ChartArea.Fill.Visible = msoFalse
        .ChartArea.Border.LineStyle = xlLineStyleNone
        .Paste
        .Export Filename:=tmpImageName, FilterName:="JPG"
    End With

    sht.Delete

    Set NewMail = olApp.CreateItem(0)
    
    With NewMail
        .subject = [subject]
        .To = ThisWorkbook.Sheets("Sheet2").Range("B1").Value
        If [ccEmail] <> "" Then .CC = ThisWorkbook.Sheets("Sheet2").Range("B3").Value
        

        .HTMLBody = "******>Dear Sir/Madam, <br/><br/>Kindly find the report below:" & _
        "<br/><img src=" & "'" & tmpImageName & "'/><br/>Regards,<br/>Saturday JM </body>"
        .Display
        
    End With
    MsgBox "Email Sent successfully"

err:

    Set olApp = Nothing
    Set NewMail = Nothing
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

 

[daverunt]

That's great. Thanks for the feedback.