I have the following code below
I need this amended so that it copies and pastes the data from F1 to last row in Col G on sheet "Email" in the body of the email before text "Regards" or if difficult, to be at the emd of the email
Sub Email_Report()
ThisWorkbook.Activate
ztext = [bodytext]
Zsubject = [subjectText]
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
ActiveWorkbook.Save
.To = Range("N1:N1").Value
.CC = Join(Application.Transpose(Range("N2:N5").Value), ";")
.BCC = ""
.Subject = Zsubject
.Body = ztext
.Attachments.Add ActiveWorkbook.FullName
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
The is what the email looks like generated from the code above
Good Morning Dave
Attached please find Parts Cash Sales
Please chase up on those Cash Sales that are over 3 days, which amounts to 23.985.60.
see details below relating to Cash Sale items outstanding for more than 3 days.
Regards
Howard
I want it to look like this
Good Morning Dave
Attached please find Parts Cash Sales
Please chase up on those Cash Sales that are over 3 days, which amounts to 23.985.60.
see details below relating to Cash Sale items outstanding for more than 3 days.
Reference Ageing Amount
622112 14 192.72
162647 13 140.76
622115 13 2644.72
622121 12 546.77
622126 11 230
622128 11 577.62
622170 11 132.5
622175 11 396.53
622178 10 560.06
622176 10 61.75
622176 10 210.29
622141 10 119.29
622142 10 1228.05
162862 7 455.52
622150 7 35.21
622157 6 380.86
622154 6 584.13
622154 6 16.97
622155 6 138.41
162627 5 211.18
622157 5 287.47
622158 5 8000
622156 5 401.1
622156 5 236.54
622160 5 920.23
622161 5 2475.03
622161 5 61.36
622162 5 700.76
622167 5 118.42
622167 5 62.87
622164 4 289.32
622164 4 162.73
622166 4 395.92
622168 4 94.37
622168 4 63.28
622166 4 68.23
622170 4 166.47
622171 4 537.05
622171 3 57.05
622171 3 24.06
Regards
Howard
Bookmarks