Hi,
I've checked a few videos even tried AI but I am struggling with this code, I want it to take 2 ranges and send it in an email, but the 2nd range always seems to override the 1st one, and thus only the 2nd table appears.
Sub SendEmail()
Dim shtSummary As Worksheet
Dim shtStats As Worksheet
Dim LastRowSummary As Long
Dim LastRowStats As Long
Dim rngSummary As Range
Dim rngStats As Range
Dim OutApp As Object
Dim OutMail As Object
' Set the summary sheet and the last row to copy
Set shtSummary = ThisWorkbook.Sheets("Summary")
LastRowSummary = shtSummary.Cells(shtSummary.Rows.Count, "I").End(xlUp).Row
' Define the summary range to copy
Set rngSummary = shtSummary.Range("I1:O" & LastRowSummary)
' Set the stats sheet and the last row to copy
Set shtStats = ThisWorkbook.Sheets("Stats")
LastRowStats = shtStats.Cells(shtStats.Rows.Count, "A").End(xlUp).Row
' Define the stats range to copy
Set rngStats = shtStats.Range("A1:Y" & LastRowStats)
' Create a new email and paste the ranges into the body
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "Reports"
.Display
'Copy the summary range and paste it into the email body
rngSummary.Copy
.GetInspector.wordEditor.Range.PasteAndFormat wdTableOverwriteStyle
'I'm guessing something needs to be between the two so that they can be separated?
' Copy the stats range and paste it into the email body
rngStats.Copy
.GetInspector.wordEditor.Range.PasteAndFormat wdTableOverwriteStyle
End With
' Clear the clipboard
Application.CutCopyMode = False
End Sub
I've checked a few videos even tried AI but I am struggling with this code, I want it to take 2 ranges and send it in an email, but the 2nd range always seems to override the 1st one, and thus only the 2nd table appears.
Sub SendEmail()
Dim shtSummary As Worksheet
Dim shtStats As Worksheet
Dim LastRowSummary As Long
Dim LastRowStats As Long
Dim rngSummary As Range
Dim rngStats As Range
Dim OutApp As Object
Dim OutMail As Object
' Set the summary sheet and the last row to copy
Set shtSummary = ThisWorkbook.Sheets("Summary")
LastRowSummary = shtSummary.Cells(shtSummary.Rows.Count, "I").End(xlUp).Row
' Define the summary range to copy
Set rngSummary = shtSummary.Range("I1:O" & LastRowSummary)
' Set the stats sheet and the last row to copy
Set shtStats = ThisWorkbook.Sheets("Stats")
LastRowStats = shtStats.Cells(shtStats.Rows.Count, "A").End(xlUp).Row
' Define the stats range to copy
Set rngStats = shtStats.Range("A1:Y" & LastRowStats)
' Create a new email and paste the ranges into the body
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "Reports"
.Display
'Copy the summary range and paste it into the email body
rngSummary.Copy
.GetInspector.wordEditor.Range.PasteAndFormat wdTableOverwriteStyle
'I'm guessing something needs to be between the two so that they can be separated?
' Copy the stats range and paste it into the email body
rngStats.Copy
.GetInspector.wordEditor.Range.PasteAndFormat wdTableOverwriteStyle
End With
' Clear the clipboard
Application.CutCopyMode = False
End Sub