Automating Emails to individual recipients based on sheet name - excel

Question

I have a large report that I have to parse through and send emails to individuals based on the data in the report. I have created a macro that allows me to split the data I need into separate sheets within the workbook so that the sheet's are named based on who the data should be emailed to.
I am struggling with finding how to automate the next step so that, based on the title of the sheet (name of person not email address), an email is sent to that person.
Currently my workaround is another macro that saves all the different sheets as separate workbooks, but that still requires me to manually send emails with attachments. Perhaps there is an easier way to automate once I have all the sheets saved as separate files?
Sub parse_data()
Dim lr As Long
Dim ws As Worksheet
Dim vcol, i As Integer
Dim icol As Long
Dim myarr As Variant
Dim title As String
Dim titlerow As Integer
vcol = 5
Set ws = sheets("Master")
lr = ws.Cells(ws.rows.count, vcol).End(xlUp).row
title = "A1:W1"
titlerow = ws.Range(title).Cells(1).row
icol = ws.Columns.count
ws.Cells(1, icol) = "Unique"
For i = 2 To lr
On Error Resume Next
If ws.Cells(i, vcol) <> "" _
And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
ws.Cells(ws.rows.count, icol).End(xlUp).offset(1) = ws.Cells(i, vcol)
End If
Next
myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
ws.Columns(icol).clear
For i = 2 To UBound(myarr)
ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
sheets.Add(after:=Worksheets(Worksheets.count)).name = myarr(i) & ""
Else
sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.count)
End If
ws.Range("A" & titlerow & ":A" & lr).EntireRow.copy sheets(myarr(i) & "").Range("A1")
sheets(myarr(i) & "").Columns.AutoFit
Next
ws.AutoFilterMode = False
ws.Activate
End Sub
Sub Splitbook()
'Split worksheets into seperate saved files'
Dim xPath As String
xPath = ActiveWorkbook.path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each xWs In ThisWorkbook.sheets
xWs.copy
ActiveWorkbook.SaveAs filename:=xPath & "\" & xWs.name & ".xlsx"
ActiveWorkbook.Close False
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Any assistance is much appreciated. Thanks in advance!