Sub Отправить_письмо()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
     
     
IRange = ActiveCell.Row 'текущая строка
For ii = 1 To 20
    If ii = 1 Then
        iTo = Range("V4").Value 'кому
    Else
        iTo = iTo + "; " + Range("V" & 3 + ii).Value 'кому
    End If
    If Range("V" & 3 + ii).Value = "" Then Exit For
Next ii
Select Case Range("A" & IRange).MergeArea.Cells(1, 1).Value
    Case 2 'второй ранг
        If Range("B" & IRange).MergeArea.Cells(1, 1).Value = "Количество а/м" Then
            iSubject = Range("B" & IRange).MergeArea.Cells(1, 1).Value ' тема сообщения
          Select Case Range("E" & IRange).Value
            Case "За текущий месяц": i = 1
            Case "За сутки": i = -1
          End Select
            iBody = Range("E" & IRange).Value & " : " & Range("C" & IRange).Value & " / " & _
                    Range("D" & IRange).Value & Chr(10) & Range("E" & IRange + i).Value & " : " & _
                    Range("C" & IRange + i).Value & " / " & Range("D" & IRange + i).Value                 ' текст сообщения
        Else
            iSubject = Range("B" & IRange).MergeArea.Cells(1, 1).Value ' тема сообщения
            iBody = Range("C" & IRange).Value & " / " & Range("D" & IRange).Value & " / " & _
                    Range("E" & IRange).Value & " / " & Range("F" & IRange).Value & " / " & _
                    Range("G" & IRange).Value & " / " & Range("H" & IRange).Value ' текст сообщения
        End If
    Case 3 'третий ранг
        iSubject = Range("B" & IRange).MergeArea.Cells(1, 1).Value ' тема сообщения
        iBody = Range("C" & IRange).Value & " / " & Range("D" & IRange).Value & " / " & _
                Range("E" & IRange).Value & " / " & Range("F" & IRange).Value & " / " & _
                Range("G" & IRange).Value & " / " & Range("H" & IRange).Value ' текст сообщения
    Case 4 ' соответственно 4 ранг
        iSubject = Range("B" & IRange).MergeArea.Cells(1, 1).Value ' тема сообщения
        iBody = Range("C" & IRange).Value & " / " & Range("D" & IRange).Value & " / " & _
                Range("E" & IRange).Value & " / " & Range("F" & IRange).Value & " / " & _
                Range("G" & IRange).Value & " / " & Range("H" & IRange).Value ' текст сообщения
End Select

    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")   'запускаем Outlook в скрытом режиме
    OutApp.Session.Logon
    On Error GoTo cleanup  'если не запустился - выходим
    Set OutMail = OutApp.CreateItem(0)   'создаем новое сообщение
    On Error Resume Next
    'заполняем поля сообщения
    With OutMail
        .to = iTo 'кому
        .Subject = iSubject  ' тема сообщения
        .Body = iBody  ' текст сообщения
        '.Attachments.Add Range("A1").Value 'вложения, если когда-то понадобится
        .Display 'команда Send - отправить без предпросмотра письма или Display - чтобы посмотреть сообщение перед отправкой
    End With
 
    On Error GoTo 0
    Set OutMail = Nothing
 
cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub