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