How can I send Excel range including header, in table, and email to list?

I have a requirement where I need to send timesheet data for the current week to each person separately in a table using Excel range:

I want to send first row data, including header, into table to joseph then send row data into table to francis.

I have written below code but it sends entire data to each person.

Sub BulkMail()

    Application.ScreenUpdating = False
    ThisWorkbook.Activate
    'Creating references to Application and MailItem Objects of Outlook
    Dim outApp As Outlook.Application
    Dim outMail As Outlook.MailItem
    'Creating variable to hold values of different items of mail
    Dim sendTo, subj, atchmnt, msg, ccTo, bccTo As String
    Dim lstRow As Long
    'My data is on sheet "Exceltip.com" you can have any sheet name.
     
    ThisWorkbook.Sheets("Sheet1").Activate
    'Getting last row of containing email id in column 3.
    lstRow = Cells(Rows.Count, 3).End(xlUp).Row
    'Variable to hold all email ids
    Dim rng As Range
    Set rng = Range("A1:D" & lstRow)
    Dim rng1 As Range
    Set rng1 = Range("C2:C" & lstRow)
    'initializing outlook object to access its features
    Set outApp = New Outlook.Application
    On Error GoTo cleanup 'to handle any error during creation of object.
    'Loop to iterate through each row, hold data in of email in variables and send
    'mail to each email id.
    For Each cell In rng1
        sendTo = Range(cell.Address).Offset(0, 0).Value2
        On Error Resume Next 'to hand any error during creation of below object
        Set outMail = outApp.CreateItem(0)
        
        'Writing and sending mail in new mail
        With outMail
            .To = sendTo
            .cc = ""
            .HTMLBody = RangetoHTML(rng)
            .Subject = timesheet
            '.Attachments.Add atchmnt
            '.Send 'this send mail without any notification. If you want see mail
            .Display
        End With
        On Error GoTo 0 'To clean any error captured earlier
        Set outMail = Nothing 'nullifying outmail object for next mail
    Next cell 'loop ends
cleanup: 'freeing all objects created
    Set outApp = Nothing
    Application.ScreenUpdating = True
    Application.ScreenUpdating = True
End Sub

Function RangetoHTML(rng As Range)
    ' Changed by Ron de Bruin 28-Oct-2006
    ' Working in Office 2000-2016
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    'Copy the range and create a new workbook to past the data in
    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
        .DrawingObjects.Delete
        On Error GoTo 0
    End With
    'Publish the sheet to a htm file
    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
    'Read all data from the htm file into RangetoHTML
    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=")
    'Close TempWB
    TempWB.Close savechanges:=False
    'Delete the htm file we used in this function
    Kill TempFile
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

Solution

You can use Application.Intersect(rng, Cell.EntireRow) to get the part of the data of the current row. And Union() that with the header row before you push it into your RangetoHTML() function.

.HTMLBody = RangetoHTML(Union(rng.Rows(1), Application.Intersect(rng, Cell.EntireRow)))