Macro to email a spastic page to addresses in the workbook

[Dave8899]

Hi sorry if this is already on her but I've been looking for 3 days now and cant find the answer.

I have the following VBA that will send a email to the address in the workbook But i need it to only send one spastic sheet names Time.
as a new book single sheet or a PDf what ever works


Sub EmailAttachmentRecipients()


ActiveSheet.Unprotect Password:="123"




Dim objOutlook As Object
Dim objNameSpace As Object
Dim objInbox As Object
Dim objMailItem As Object
Set objOutlook = CreateObject("Outlook.Application")
Set objNameSpace = objOutlook.GetNamespace("MAPI")
Set objInbox = objNameSpace.Folders(1)
Set objMailItem = objOutlook.CreateItem(0)


Dim StrTo As String
Dim i As Integer
StrTo = ""
i = 1


With Worksheets("Email")
Do
StrTo = StrTo & .Cells(i, 1).Value & "; "
i = i + 1
Loop Until IsEmpty(.Cells(i, 1))
End With


StrTo = Mid(StrTo, 1, Len(StrTo) - 2)


With objMailItem
.To = StrTo
.CC = ""
.Subject = "Time sheet for " & Format(Sheets("Email").Range("n2")) & Format(Sheets("Email").Range("L2"))
.Body = _
"Hi," & Chr(10) & Chr(10) & _
"Please see attached Time sheet for the above individual" & Chr(10) & _
""
.Attachments.Add ActiveWorkbook.FullName
.Display
End With




Set objOutlook = Nothing
Set objNameSpace = Nothing
Set objInbox = Nothing
Set objMailItem = Nothing


ActiveSheet.Protect Password:="123"


End Sub