マクロ VBA メール送信

###前提・実現したいこと
マクロで取込データを、別データのフォーマットの項目でフィルターをかけ、
指定列ごとコピーしフォーマット側にペースト、
次の項目でフィルターをかけ、指定列ごとコピーしフォーマット側にペーストを繰り返し、
フォーマット側の項目がなくなったら次シートの項目でフィルターをかけて……
というループをさせ、最終シートまで繰り返す。
というマクロです。
このマクロを回し終わった後に、
シート毎に別々の人にメールを送る機能を追加したいのですが、
最短で送れる構文を作るとしたら、どうされますか？
一応、マスタを作成してそこから必要な情報取込、送信という処理をループさせようと考えています。
皆様の知恵をお貸しください。
よろしくお願いします。

Option Explicit

Dim gyo As Long
Dim gyo2 As Long
Dim gyo3 As Long
Dim filecount As Long
Dim sheetcount As Long
Dim unmatch As Long
Dim erfilecount As Long
'ボタンを押したとき
Sub FolderSelect()
    'ThisWorkbook.Worksheets(1).Range("A6:C3005").ClearContents
    'ThisWorkbook.Worksheets(2).Range("B1:BE3005").ClearContents
    Dim folderpass As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
            folderpass = .SelectedItems(1)
        Else
            ThisWorkbook.Worksheets(1).Range("B3").Value = "キャンセルしました。"
            Exit Sub
        End If
    End With
    
    filecount = 0
    sheetcount = 0
    unmatch = 0
    erfilecount = 0
    gyo = 6
    gyo2 = 2
   
    
    ThisWorkbook.Worksheets(1).Range("B2").Value = "処理中"
    
    Call FileSearch(folderpass, "*.csv")
   Dim dateupdate As String
   dateupdate = Year(Date) & "年" & Month(Date) & "月" & Day(Date) & "日更新"
   'ThisWorkbook.Worksheets(2).Range("A1").Value = dateupdate
   'ThisWorkbook.Worksheets(2).Name = dateupdate '
   ThisWorkbook.Worksheets(1).Range("B2").Value = "完了"
   ThisWorkbook.Worksheets(2).Activate
End Sub
'ファイル検索
Sub FileSearch(Path As String, Target As String)
    Dim FSO As Object, Folder As Variant, File As Variant
    Set FSO = CreateObject("Scripting.FileSystemObject")
    For Each Folder In FSO.GetFolder(Path).SubFolders
        Call FileSearch(Folder.Path, Target)
    Next Folder
    For Each File In FSO.GetFolder(Path).Files
        If File.Name Like Target Then
            filecount = filecount + 1
            ThisWorkbook.Worksheets(1).Cells(gyo, 1) = File.Name
            ThisWorkbook.Worksheets(1).Cells(gyo, 2) = File.Path
            Call ParCopy(File.Path)
            gyo = gyo + 1
        End If
    ThisWorkbook.Worksheets(1).Range("B3").Value = filecount & "個のファイルが見つかりました。"
    Next File
End Sub
''一覧出力
Sub ParCopy(Path As String)


    Dim openbook As Workbook
    Dim openbooksheet As Worksheet
    Dim lp As Long
    Dim el As Long
    Dim br As String
    'オ
    Dim c As Range, Target As Range
    Dim LastRow As Long
    '縦軸(マクロ側シート数用)
    lp = 2
    '横軸(データ側ループ管理用)
    el = 3

    
    
    Application.ScreenUpdating = False

    On Error GoTo myError
    Set openbook = Application.Workbooks.Open(Path)



        Set openbooksheet = openbook.Worksheets(1)
        openbooksheet.Unprotect
        
        
      Do Until lp = 28
    
        Do Until ThisWorkbook.Worksheets(lp).Cells(1, el) = ""
        
          br = ThisWorkbook.Worksheets(lp).Cells(2, el)
          
          openbooksheet.Activate
          
          Selection.AutoFilter
          openbooksheet.Range("A1").AutoFilter Field:=8, Criteria1:=br
          
          LastRow = 291826
          
          openbooksheet.Range("J2:J" & LastRow).Copy ThisWorkbook.Worksheets(lp).Range(ThisWorkbook.Worksheets(lp).Cells(3, el), ThisWorkbook.Worksheets(lp).Cells(3, el))
          openbooksheet.Range("A1").AutoFilter
    
      
          el = el + 1
    
        Loop
         
         el = 3
         
         lp = lp + 1
      Loop
       

  
    openbook.Close False
    

    Application.ScreenUpdating = True
    Exit Sub
myError:
    MsgBox Err.Description
    ThisWorkbook.Worksheets(1).Cells(gyo, 3) = "エラー発生"
    erfilecount = erfilecount + 1
    Application.ScreenUpdating = True
End Sub