VBA: Email individual Sheets to email value in cell

[Eean]

I want to email each sheet in my workbook (30 sheets) to the email address in cell A1.
The email address is different on each sheet.
What I have below works for the active sheet but isn't attaching it.

Sub Mailmacro()

Dim OutApp As Object
Dim OutMail As Object
Dim mymail As String

mymail = Range("A1").Value
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.to = mymail
.CC = ""
.BCC = ""
.Subject = "Email subject "
.Body = "Body"
.Attachments.Add ActiveWorksheet.FullName

.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

Can anyone help?

 

[Smitty]

If you want to attach individual sheets to individual recipients, then you can make a temporary copy of the worksheet as a new workbook, attach it and then kill it.

I believe that Ron DeBruin has code to do that at Excel Automation - Ron de Bruin.

HTH,

 

[Eean]

Cheers Smitty - I'll give that a try!