Sub Заявка()
Dim adressTo$, fname$, theme$, Disclaimer$
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim rng As Range

Set sh = ThisWorkbook.Sheets("Заявка")

With Application
    .DisplayAlerts = False
    .EnableEvents = False
    .ScreenUpdating = False
End With

With sh
    .AutoFilterMode = False
    .Range("$A$3:$B$3").AutoFilter Field:=2, Criteria1:="<>"
End With

Set rng = sh.Range("A3").CurrentRegion

With sh
    adressTo = .Range("P4").Value
    adressCC = .Range("P5").Value
    theme = .Range("C1").Value
    Disclaimer = .Range("C2").Value
End With

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next

Dim YourHTMLBody As String, iStart As Long, iEnd As Long

With OutMail
    .To = adressTo
    .CC = adressCC
    .BCC = ""
    .Subject = theme
    .BodyFormat = 2
    .Display
    YourHTMLBody = "<p style=font-size:11pt;font-family:Calibri;>" & Disclaimer & _
    RangetoHTML(rng) & vbCrLf & "<p style=font-size:11pt;font-family:Calibri;></a>"
    iStart = InStr(1, .HTMLBody, "<div class=WordSection1>", vbTextCompare)
    iEnd = InStr(1, .HTMLBody, "<p class=MsoNormal><a name=""_MailAutoSig"">", vbTextCompare)
    If iStart > 0 And iEnd > 0 Then
        .HTMLBody = Left(.HTMLBody, iStart - 1) & YourHTMLBody & Mid(.HTMLBody, iEnd)
    End If
    
End With

Set OutMail = Nothing
Set OutApp = Nothing
sh.AutoFilterMode = False
ThisWorkbook.Save

With Application
    .EnableEvents = True
    .ScreenUpdating = True
    .DisplayAlerts = True
End With

End Sub

With OutMail ' свойства элемента (письма)
    .To = adressTo ' получатель сообщения
    .CC = adressCC ' получатели копии сообщения
    .BCC = "" ' отправка элемента (письма) только основным получателям
    .Subject = theme
    .BodyFormat = 2 ' формат создаваемого элемента (письма) установить HTML
    .Display ' вставит подпись
    YourHTMLBody = "<p style=font-size:11pt;font-family:Calibri;>" & Disclaimer & _
    RangetoHTML(rng) & vbCrLf & "<p style=font-size:11pt;font-family:Calibri;></a>"
    iStart = InStr(1, .HTMLBody, "<div class=WordSection1>", vbTextCompare)
    iEnd = InStr(1, .HTMLBody, "<p class=MsoNormal><a name=""_MailAutoSig"">", vbTextCompare)
    If iStart > 0 And iEnd > 0 Then
        .HTMLBody = Left(.HTMLBody, iStart - 1) & YourHTMLBody & Mid(.HTMLBody, iEnd)
    End If
    
End With

Sub Проверка()
Dim adressTo$, fname$, theme$, Disclaimer$
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim rng As Range

Set sh = ThisWorkbook.Sheets("Расчет")

With Application
    .DisplayAlerts = False
    .EnableEvents = False
    .ScreenUpdating = False
End With

With sh
    .AutoFilterMode = False
    .Range("$A$3:$B$3").AutoFilter Field:=2, Criteria1:="<>" ' диапазон таблицы
End With

Set rng = sh.Range("A3").CurrentRegion

With sh
    adressTo = .Range("O3").Value ' получатель сообщения
    adressCC = .Range("O4").Value ' получатели копии сообщения
    theme = "согласование" & .Range("A4").Value & " " & .Range("T4").Value & " " & .Range("T5").Value & " " & .Range("T6").Value & " " & .Range("T7").Value & " " & .Range("T8").Value & " " & .Range("T9").Value & " " & .Range("T10").Value & " " & .Range("T11").Value & " " & .Range("T12").Value & " " & .Range("T13").Value & " " & .Range("T14").Value & " " & .Range("T15").Value & " " & .Range("T16").Value & " " & .Range("T17").Value & " " & .Range("T18").Value & " " & .Range("T19").Value & " " & .Range("T20").Value & " " & .Range("T21").Value & " " & .Range("T22").Value & " " & .Range("T23").Value & " " & .Range("T24").Value ' тема сообщения
    Disclaimer = .Range("P3").Value ' текст сообщения
End With

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next

With OutMail
    .To = adressTo ' получатель сообщения
    .CC = adressCC ' получатели копии сообщения
    .BCC = ""
    .Subject = theme ' тема сообщения
    .HTMLBody = "<p style=font-size:11pt;font-family:Calibri;>" & Disclaimer & _
    RangetoHTML(rng) & vbCrLf & "<p style=font-size:11pt;font-family:Calibri;></a>"
    .Display

End With

Set OutMail = Nothing
Set OutApp = Nothing
sh.AutoFilterMode = False
ThisWorkbook.Save


With Application
    .EnableEvents = True
    .ScreenUpdating = True
    .DisplayAlerts = True
End With

End Sub