Get data from multiple cells

Question

I'm using VBA code from Ron de Bruin that sends every sheet with an email address to the address in a specified cell. It's meant to send the sheet as an attachment.

I want to get data from multiple cells, to put in the body of the email.

I commented out the parts that send the attachment and sent an email that contained data from one cell in the body of the email.

I cannot get data from multiple cells. The email arrives blank.

Sub Mail_Every_Worksheet()
'Working in Excel 2000-2016
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
Dim sh As Worksheet
Dim wb As Workbook
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object

TempFilePath = Environ$("temp") & "\"

If Val(Application.Version) < 12 Then
    'You use Excel 97-2003
    FileExtStr = ".xls": FileFormatNum = -4143
Else
    'You use Excel 2007-2016
    FileExtStr = ".xlsm": FileFormatNum = 52
End If

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

Set OutApp = CreateObject("Outlook.Application")

For Each sh In ThisWorkbook.Worksheets
    If sh.Range("B1").Value Like "?*@?*.?*" Then

        sh.Copy
        Set wb = ActiveWorkbook

        TempFileName = "Sheet " & sh.Name & " of " _
                     & ThisWorkbook.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

        Set OutMail = OutApp.CreateItem(0)

        With wb
            .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum

            On Error Resume Next
            With OutMail
                .To = sh.Range("B1").Value
                .CC = ""
                .BCC = ""
                .Subject = "Monthly Shirt Sales"
                Dim cell As Range
                Dim strbody As String
                For Each cell In 
                ThisWorkbook.Sheets("Sheet1").Range("A4:A36")
                strbody = strbody & cell.Value & vbNewLine
                Next
                '.Attachments.Add wb.FullName
                'You can add other files also like this
                '.Attachments.Add ("C:\test.txt")
                .Send   'or use .Display
            End With
            On Error GoTo 0

            .Close savechanges:=False
        End With

        Set OutMail = Nothing

        Kill TempFilePath & TempFileName & FileExtStr

    End If
Next sh

Set OutApp = Nothing

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

It works to send the data from one cell when I replace

Dim cell As Range
Dim strbody As String
For Each cell In ThisWorkbook.Sheets("Sheet1").Range("A4:A36")
strbody = strbody & cell.Value & vbNewLine
Next

with this:

.Body = sh.Range("A4").Value

so I thought that using this would work:

.Body = sh.Range("A4:B36").Value

but it also does not get data and sends a blank email.

How do I get data from multiple cells?

Answer 1

You need to loop through the range and combine the values in the range like in the following example;

Dim strbody As String

For Each cell In sh.Range("A1:B2")
    strbody = strbody & cell.Value  & vbNewLine
Next cell

Then include the strbody in you outlook with statement

With OutMail
    .To = sh.Range("B1").Value
    .CC = ""
    .BCC = ""
    .Subject = "Monthly Shirt Sales"
    .Body = strbody
    .send   'or use .Display
End With