Copy pasting excel range in outlook email body(with added text) in Loop VBA

[Prasad Kulkarni]

This is my first question to this wonderful community.

I am developing a macro (basically copy pasting it from various sources) which will enable us to autofilter in loop various stacks of data in excel. Paste the visible cells in outlook email body, add a before and after text and then send it across. These are payment reminders which necessitates us to give them list of unpaid invoices.

I have cobbled up a macro which is close enough of doing this, and it works perfectly fine when i run it for single sequence. But falters terribly when i run it in loop. It copy pastes different invoices for different customers and sometimes it pastes the excel range above the opening/greeting line.

Am quite confused. I tried using the Ron de Bruin codes but not able to run it with the added function.

Let me know if i have not put up my question clearly or if i should have searched this site for an already available answer.

Thanks in advance. P.s (Attaching my code)

Sub Macro4()
'
' Macro4 Macro
'

'

'Macro Purpose: To send an email through Outlook

    Dim objOutlook As Object
    Set objOutlook = CreateObject("Outlook.Application")
    Dim objMail As Object
    Dim rngTo As Range
    Dim rngto2 As Range

    Dim rngCc As Range
    Dim rngSubject As Range
    Dim rngBody As Range
        Dim Fno As Long
    Dim max As Long
    Fno = 1
    Range("T1").Select
    max = ActiveCell.Value


Do
If Fno > max Then
MsgBox "No more records to copy"
Exit Sub

End If

'Application.Wait (Now + TimeValue("00:00:02"))
Cells.Select
    Selection.AutoFilter
    Range("C3").Select
    ActiveSheet.Range("$A$1:$S$1127").AutoFilter Field:=10, Criteria1:=Fno
    Range("A1:I11111").Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy


'Application.Wait (Now + TimeValue("0:00:01"))
    Sheets("Sheet2").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Range("A1:I1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Dim myCells As Range
Set myCells = Selection



'Application.Wait (Now + TimeValue("0:00:01"))
    Set objOutlook = CreateObject("Outlook.Application")

    Set objMail = objOutlook.CreateItem(0)

    With ActiveSheet
        Set rngTo = .Range("j2")
      Set rngto2 = .Range("ag1")
      Set rngto3 = .Range("ah1")
      Set rngCc = .Range("af2")
      Set rngCc1 = .Range("ag2")
        Set rngSubject = .Range("Q2")
        Set rngBody = .Range(.Range("a1:i1"), .Range("a1:i1").End(xlDown))
    End With
    rngBody.Copy
'Application.Wait (Now + TimeValue("0:00:04"))
    With objMail
      .To = rngTo.Value

            .Cc = rngCc.Value & ";" & rngCc1.Value
        .Subject = rngSubject.Value
        .body = "Hi Team" & vbNewLine & "Find below my comments." & vbNewLine & vbNewLine
        .Display
' Application.Wait (Now + TimeValue("0:00:01"))

    SendKeys "({DOWN})"
SendKeys "({DOWN})"
SendKeys "({DOWN})"
SendKeys "({DOWN})"
    'Application.Wait (Now + TimeValue("00:00:02"))

    SendKeys "^({v})", True

    SendKeys "%({s})", True
  End With
      Application.Wait (Now + TimeValue("00:00:05"))

    'Set objOutlook = Nothing
    Set objMail = Nothing
    Set rngTo = Nothing
    Set rngCc = Nothing
    Set rngSubject = Nothing
    Set rngBody = Nothing
Fno = Fno + 1
Sheets("Sheet1").Select
Range("a1").Select
Application.Wait (Now + TimeValue("0:00:05"))
Loop


End Sub