Sub SendMail()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range

    Range("B1:M35").Copy
 
    'создаем новое пустое сообщение в Outlook
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    On Error GoTo cleanup
    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
    
    With OutMail
        .To = "vasya@pupkin.com"
        .Subject = "Выполнение графиков движения автобусов за " & ThisWorkbook.ActiveSheet.Name
        .Body = "Здравствуйте! Высылаю данные о выполнении графиков движения автобусов за " & ThisWorkbook.ActiveSheet.Name & "г."
        'вместо Send можно использовать Display, чтобы посмотреть сообщение перед отправкой
    End With
    
    OutMail.Display
    
AppActivate Title:="Выполнение графиков движения автобусов за Январь 2022 - Сообщение (HTML)"
    
'  Перемещаю курсор
    For i = 1 To 100
SendKeys ("{right}")
    Next
      
    Selection.Paste

    On Error GoTo 0
    Set OutMail = Nothing

cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub