loop through worksheets

[ummjay]

how can i loop through worksheets within a workbook. I want to exclude the first two worksheets (RUN, and Results) Tried my loop below, but seems to only be looping on sheet1 ("Run").

Sub GOEmail()
Dim myOlApp As Object 'Outlook.Application
Dim MyItem As Object 'Outlook.MailItem
Dim strBody As String
Dim strLink As String
Dim strLinkText As String
Dim strNewText As String
Dim strCurrentTime As String
Dim strNewTime As String
Dim strTimeZone As String
Dim strSenderTarget As String
Dim strCompany As String
Dim strToEmails As String
Dim strblank As String
Dim celHome As Range, rg As Range, rgCopy As Range
Dim iCol As Long, n As Long
Dim r As Range
Dim rng As Range
Dim wksTemp As Worksheet
Dim msgDoc As Object 'outlook wordprocessing editor


    Set myOlApp = CreateObject("Outlook.Application")
    
    'start to loop
    
        
        Set wksTemp = ActiveSheet
        
        Set rng = Range("B1", Range("B" & Rows.Count).End(xlUp))

        For Each r In rng   'loop through each work effort
        
            Set MyItem = myOlApp.CreateItem(olMailItem)
            With MyItem
                .CC = "ecsfutglobal"
                .BCC = ""
                strBody = .HTMLBody
        
                'STRING VALUES
                strSenderTarget = Cells(r.Row, "C")
                strCurrentTime = Cells(r.Row, "F")
                strCompany = Cells(r.Row, "B")
                strTimeZone = Cells(r.Row, "G")
        
                'What to Replace
                .HTMLBody = "body of text"
                    
                .Subject = "subj"
                .SentOnBehalfOfName = "addy"
        
                    .To = r.Value
                    .Importance = 2
                    Set msgDoc = MyItem.GetInspector.WordEditor
        msgDoc.Select
        msgDoc.Windows(1).Selection.Copy
        
        MyItem.BodyFormat = olFormatRichText
        
        msgDoc.Range.Paste

                    .Display
                    '.BodyFormat = 3
            End With
            Wait
        Next r

    Set MyItem = Nothing
    Set myOlApp = Nothing
    
    Worksheets("RUN").Activate
    MsgBox "Macro Completed. All Emails composed for review", vbOKOnly, "Macro Completed"
    
    Application.DisplayAlerts = False
    Application.DisplayAlerts = True


End Sub

 

[VoG]

Maybe

Sub GOEmail()
Dim myOlApp As Object 'Outlook.Application
Dim MyItem As Object 'Outlook.MailItem
Dim strBody As String
Dim strLink As String
Dim strLinkText As String
Dim strNewText As String
Dim strCurrentTime As String
Dim strNewTime As String
Dim strTimeZone As String
Dim strSenderTarget As String
Dim strCompany As String
Dim strToEmails As String
Dim strblank As String
Dim celHome As Range, rg As Range, rgCopy As Range
Dim iCol As Long, n As Long
Dim r As Range
Dim rng As Range
Dim wksTemp As Worksheet
Dim msgDoc As Object 'outlook wordprocessing editor
Dim i As Long


    Set myOlApp = CreateObject("Outlook.Application")
    
    'start to loop
    
For i = 3 To Worksheets.Count
        Set wksTemp = Worksheets(i)
        With wksTemp
        
        Set rng = .Range("B1", Range("B" & Rows.Count).End(xlUp))

        For Each r In rng   'loop through each work effort
        
            Set MyItem = myOlApp.CreateItem(olMailItem)
            With MyItem
                .CC = "ecsfutglobal"
                .BCC = ""
                strBody = .HTMLBody
        
                'STRING VALUES
                strSenderTarget = .Cells(r.Row, "C")
                strCurrentTime = .Cells(r.Row, "F")
                strCompany = .Cells(r.Row, "B")
                strTimeZone = .Cells(r.Row, "G")
        
                'What to Replace
                .HTMLBody = "body of text"
                    
                .Subject = "subj"
                .SentOnBehalfOfName = "addy"
        
                    .to = r.Value
                    .Importance = 2
                    Set msgDoc = MyItem.GetInspector.WordEditor
        msgDoc.Select
        msgDoc.Windows(1).Selection.Copy
        
        MyItem.BodyFormat = olFormatRichText
        
        msgDoc.Range.Paste

                    .Display
                    '.BodyFormat = 3
            End With
            Wait
        Next r
    End With
    Next i

    Set MyItem = Nothing
    Set myOlApp = Nothing
    
    Worksheets("RUN").Activate
    MsgBox "Macro Completed. All Emails composed for review", vbOKOnly, "Macro Completed"
    
    Application.DisplayAlerts = False
    Application.DisplayAlerts = True


End Sub

 

[ummjay]

perfect, thanks!