Run VBScript on all sheets not just 1

[audioguy]

I'm trying to create a script that will Email a range of each page to an Email address in a column.
I've got a script that will Email 1 page at a time, but I would like for it to run as a batch (up to 200 worksheets in the book)

Heres what I've got that works perfectly for Sheet 1, but I want it to ignore the name of the sheet and just run the script on each.

Sub EmailRange()

Dim MailSelection As Object
Dim cell As Range
Dim Subject As String
Dim EmailAddress As String



ThisWorkbook.Sheets("Sheet1").Range("B6:o11").Copy



Set OutlookApp = CreateObject("Outlook.Application")

For Each cell In _
Columns("B").Cells
If cell.Value Like "*@*" Then
    Subject = "Subject"
    EmailAddress = cell.Value
    
    Set MailSelection = OutlookApp.CreateItem(0)
    With MailSelection
        .To = EmailAddress
        .Subject = Subject
        .Display
        SendKeys "^({v})", True
        End With
    End If
Next
End Sub

Like I said- this works well for Sheet1, but I need it for ALL sheets- is there a simple tweak to this line: ThisWorkbook.Sheets("Sheet1") to make it work?

Thanks for such an amazing resource.

 

[schielrn]

Maybe try this, but NOTE it will go through every sheet in the workbook.

Sub EmailRange()
 
Dim MailSelection As Object
Dim cell As Range
Dim Subject As String
Dim EmailAddress As String
 
Set OutlookApp = CreateObject("Outlook.Application")
 
for each ws in ThisWorkbook.WorkSheets
ws.Range("B6:o11").Copy
 
For Each cell In _
ws.Columns("B").Cells
If cell.Value Like "*@*" Then
    Subject = "Subject"
    EmailAddress = cell.Value
 
    Set MailSelection = OutlookApp.CreateItem(0)
    With MailSelection
        .To = EmailAddress
        .Subject = Subject
        .Display
        SendKeys "^({v})", True
        End With
    End If
Next cell
next ws
End Sub

 

[audioguy]

Worked perfectly, thank you so much!