Loop Macro to save each tab as an individual PDF and automatically email out

[erenkey]

I have a workbook in Excel that has multiple tabs. I have a macro that will save the active tab as a PDF and then email the PDF to the email address that is in cell AB1. The code works great if I run it for each tab individually. I would like to loop the macro to run for each tab in the workbook. Can anyone help me add the necessary code for the loop?

Here is the code that I am using.

Sub Individual_Scores()
ChDir "C:\Users\eenkey\Dropbox (RheoVest)\RheoVest's shared workspace\Zubie\Headquarters"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\eenkey\Dropbox (RheoVest)\RheoVest's shared workspace\Zubie\Headquarters\" & ActiveSheet.Name & ".pdf", OpenAfterPublish:=True

Dim OutLookApp As Object
Dim OutLookMailItem As Object
Dim myAttachments As Object

Set OutLookApp = CreateObject("OutLook.Application")
Set OutLookMailItem = OutLookApp.CreateItem(0)
Set myAttachments = OutLookMailItem.Attachments

With OutLookMailItem
.to = Range("AB1").Value
.Subject = ActiveSheet.Name & " Zubie Scores"
.Body = "Testing Save to PDF and Email."
myAttachments.Add "C:\Users\eenkey\Dropbox (RheoVest)\RheoVest's shared workspace\Zubie\Headquarters\" & ActiveSheet.Name & ".pdf"
.Send
End With

Set OutLookMailItem = Nothing
Set OutLookApp = Nothing


End Sub

 

[xlyfe]

Does this work?

      Sub Individual_Scores()

         Dim wsCnt As Integer
         Dim i As Integer

         wsCnt = ActiveWorkbook.Worksheets.Count

         For i = 1 To wsCnt

            ChDir "C:\Users\eenkey\Dropbox (RheoVest)\RheoVest's shared workspace\Zubie\Headquarters"
            ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            "C:\Users\eenkey\Dropbox (RheoVest)\RheoVest's shared workspace\Zubie\Headquarters\" & ActiveSheet.Name & ".pdf", OpenAfterPublish:=True
            
            Dim OutLookApp As Object
            Dim OutLookMailItem As Object
            Dim myAttachments As Object
            
            Set OutLookApp = CreateObject("OutLook.Application")
            Set OutLookMailItem = OutLookApp.CreateItem(0)
            Set myAttachments = OutLookMailItem.Attachments
            
            With OutLookMailItem
            .To = Range("AB1").Value
            .Subject = ActiveSheet.Name & " Zubie Scores"
            .Body = "Testing Save to PDF and Email."
            myAttachments.Add "C:\Users\eenkey\Dropbox (RheoVest)\RheoVest's shared workspace\Zubie\Headquarters\" & ActiveSheet.Name & ".pdf"
            .Send
            End With
            
            Set OutLookMailItem = Nothing
            Set OutLookApp = Nothing

         Next i

      End Sub

 

[erenkey]

Sub Individual_Scores() Dim wsCnt As Integer Dim i As Integer wsCnt = ActiveWorkbook.Worksheets.Count For i = 1 To wsCnt ChDir "C:\Users\eenkey\Dropbox (RheoVest)\RheoVest's shared workspace\Zubie\Headquarters" ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ "C:\Users\eenkey\Dropbox (RheoVest)\RheoVest's shared workspace\Zubie\Headquarters\" & ActiveSheet.Name & ".pdf", OpenAfterPublish:=True Dim OutLookApp As Object Dim OutLookMailItem As Object Dim myAttachments As Object Set OutLookApp = CreateObject("OutLook.Application") Set OutLookMailItem = OutLookApp.CreateItem(0) Set myAttachments = OutLookMailItem.Attachments With OutLookMailItem .To = Range("AB1").Value .Subject = ActiveSheet.Name & " Zubie Scores" .Body = "Testing Save to PDF and Email." myAttachments.Add "C:\Users\eenkey\Dropbox (RheoVest)\RheoVest's shared workspace\Zubie\Headquarters\" & ActiveSheet.Name & ".pdf" .Send End With Set OutLookMailItem = Nothing Set OutLookApp = Nothing Next i End Sub

Thanks for the reply but the loop is not working. When I run the code it only runs for the first tab but not any of the others.

 

[erenkey]

Does anyone have any suggestions? I believe that I need to change the "ActiveSheet" line in the code because what I am wanting it to do utilizes all of the sheets in the workbook instead of only the active one.

or

Is there a way to assign this macro to a specific worksheet by naming it in the code somewhere? I can then recreate the same code for each defines worksheet and then create a call macro that will call all of my individual macros in order. I know this is not the most efficient way to do it but it should work.

Thank you for any help.