Send an email from excel

[leemcder]

Hi, I am hoping someone could please provide me with some assistance, this Macro is used at work to send an email to people specified in a specific cell in excel, if a person has more than one row, they still only receive one email but it contains all the information relating to them. What I now want it to do is send a separate email for each row, so people will receive more than just one email each. I also want the subject to be the contents of cell F. Could someone please take a look and amend or please tell me what needs changed to do this? Your help is much appreciated.

 Sub Send_Row_Or_Rows_1()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim rng As Range
    Dim Ash As Worksheet
    Dim Cws As Worksheet
    Dim Rcount As Long
    Dim Rnum As Long
    Dim FilterRange As Range
    Dim FieldNum As Integer
    Dim mailAddress As String

    On Error GoTo cleanup
    Set OutApp = CreateObject("Outlook.Application")
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    Set Ash = ActiveSheet
    Set FilterRange = Ash.Range("A1:H" & Ash.Rows.Count)
    FieldNum = 1
    Set Cws = Worksheets.Add
    FilterRange.Columns(FieldNum).AdvancedFilter _
            Action:=xlFilterCopy, _
            CopyToRange:=Cws.Range("A1"), _
            CriteriaRange:="", Unique:=True
    Rcount = Application.WorksheetFunction.CountA(Cws.Columns(1))
    If Rcount >= 2 Then
        For Rnum = 2 To Rcount
            FilterRange.AutoFilter Field:=FieldNum, _
                                   Criteria1:=Cws.Cells(Rnum, 1).Value
            mailAddress = ""
            On Error Resume Next
            mailAddress = Application.WorksheetFunction. _
                          VLookup(Cws.Cells(Rnum, 1).Value, _
                                Worksheets("Mailinfo").Range("A1:B" & _
                                Worksheets("Mailinfo").Rows.Count), 2, False)
            On Error GoTo 0
            If mailAddress <> "" Then
                With Ash.AutoFilter.Range
                    On Error Resume Next
                    Set rng = .SpecialCells(xlCellTypeVisible)
                    On Error GoTo 0
                End With
                Set OutMail = OutApp.CreateItem(0)
                On Error Resume Next
                With OutMail
                    .to = mailAddress
                    .Subject = "Medical Reporting Solutions outstanding fees"
                    .HTMLBody = RangetoHTML(rng)
                    .Display  'Or use Send
                End With
                On Error GoTo 0
                Set OutMail = Nothing
            End If
            Ash.AutoFilterMode = False
        Next Rnum
    End If
cleanup:
    Set OutApp = Nothing
    Application.DisplayAlerts = False
    Cws.Delete
    Application.DisplayAlerts = True
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub