Sub SendMail()
Dim WS As Worksheet
With ActiveWorkbook
For Each WS In ActiveWorkbook.Worksheets
If WS.Cells(1, 1) = "Action items" Then
RW = 3: AI = ""
Do
If WS.Cells(RW, 6) = "" Then AI = WS.Cells(RW, 1)
If WS.Cells(RW, 8) = "Open" Then
.SendMail Recipients:=Array(WS.Cells(RW, 5)), SUBJECT:=AI & "/" & WS.Cells(RW, 1) & ":" & WS.Cells(RW, 2) & ":" & WS.Cells(RW, 3) & Format(WS.Cells(RW, 7), " dd/mmm/yy")
End If
RW = RW + 1
Loop Until WS.Cells(RW, 1) = ""
End If
Next WS
' .Close SaveChanges:=False 'are you sure that you want to close the Excel?
End With
End Sub