Multiple email recipients from excel

Hi,

I have obtained the following code which works great apart from the fact that I want to just send one email to all addressees instead of multiple emails. Is there someone who could help modify it please;

Sub TestFile()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    Dim strbody As String

    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon

    On Error GoTo cleanup
    For Each cell In Range("G1:G20")
        strbody = strbody & cell.Value & vbNewLine
    Next
    For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value Like "?*@?*.?*" And _
           LCase(Cells(cell.Row, "C").Value) = "yes" Then

            Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail
                .BCC = cell.Value
                .Subject = "Reminder"
                .Body = "Dear " & Cells(cell.Row, "A").Value & vbNewLine & vbNewLine & strbody
                'You can add files also like this
                '.Attachments.Add ("C:\test.txt")
                .Display  'Or use Send
            End With
            On Error GoTo 0
            Set OutMail = Nothing
        End If
    Next cell

cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub

I appreciate any help offered

Kind regards

Steve