Sub mail()
Dim OutApp As Object
Dim OutMail As Object
Dim rn As Range
Set rn = Range("F3:F7")
For Each st In rn
b = b & st.Value & Chr(10)
Next
b = b & Chr(10) & Chr(10) & "Склад №1"
Subj = "Складские запасы"
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
     
     With OutMail
        For i = 2 To 4
            .Recipients.Add (Worksheets("Список рассылки").Cells(i, 1).Value)
        Next
        .Subject = Subj
        .body = b
        .Display
    End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub