VBA rookie back for help. Not sure if what I'm trying to do is possible (or at least as simple as I'm trying to make it).
I have a workbook where I have a macro that splits a main sheet into new sheets based on unique email addresses. I now want to email each sheet based on the email address in cell C2 of each sheet. Would prefer to copy all visible cells in the sheet and paste into .HTMLBody but if I have to save and attach that is okay too. Currently my code is opening Outlook and using the email address in cell C2 of the last sheet, rather than looping through each sheet, and it isn't pasting anything. Thank you in advance for your help.
I have a workbook where I have a macro that splits a main sheet into new sheets based on unique email addresses. I now want to email each sheet based on the email address in cell C2 of each sheet. Would prefer to copy all visible cells in the sheet and paste into .HTMLBody but if I have to save and attach that is okay too. Currently my code is opening Outlook and using the email address in cell C2 of the last sheet, rather than looping through each sheet, and it isn't pasting anything. Thank you in advance for your help.
Code:
Sub
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim Work As Worksheet
Dim Lastrow As String
Lastrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
Set rng = Nothing
On Error Resume Next
Set rng = ActiveSheet.Range("A1:D" & Lastrow).Select
On Error GoTo 0
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
For Each Work In Worksheets
.To = ActiveSheet.Range("C2")
.CC = "test@ferguson.com"
.Subject = "Test RGA Request"
.HTMLBody = rng & ActiveSheet.PasteSpecial
.Display
Next Work
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub