Here is the code I am using to copy over the ranges as well as open a new excel email. I can get both to copy and paste over just fine, but my issue is that when the second picture pastes, it replaces the first picture as opposed to being pasted above it like I need it to. What am I doing wrong?
Private Sub CommandButton4_Click()
'Finds last Row of email report
Dim lRow As Long
Dim lCol As Long
lRow = Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).row
'Copy range of interest
Dim r As Range
Set r = Sheets("Email").Range(Cells(8, "E"), Cells(lRow, "N"))
r.Copy
'Open a new mail item
Dim outlookApp As Outlook.Application
Set outlookApp = CreateObject("Outlook.Application")
Dim outMail As Outlook.MailItem
Set outMail = outlookApp.CreateItem(olMailItem)
With outMail
.To = ""
.CC = ""
.BCC = ""
.Subject = shift_txtb2.Text & " " & "Finishing Report" & " " & Format(Now(), "MM/DD/YY")
.HTMLBody = ""
'Attachments.Add
.Display
End With
''Get its Word editor
outMail.Display
Dim wordDoc As Word.Document
Set wordDoc = outMail.GetInspector.WordEditor
''To paste as picture
wordDoc.Range.PasteAndFormat wdChartPicture
Set r = Sheets("Email").Range("P8:T17")
r.Copy
wordDoc.Range.PasteAndFormat wdChartPicture
Unload Me
Sheets(1).Activate
End Sub