Macro to send individual tabs from a worksheet to different email address based on in

(source)
I'm not quite sure what I'm doing wrong but i I get the "Please activate the data sheet to parse/email and then run this macro. Aborting." message every time. I am always on the supplier sheet so it is the active sheet. I made some minor code adjustments to fit my needs but i don't see why they would be effecting it. here it is:

Option Explicit

Sub ParseItemsAndEmail()
'Jerry Beaucaire  (4/22/2010)
'Based on selected column, data is filtered to individual workbooks
'workbooks are named for the value plus today's date
Dim LR As Long, BR As Long, Itm As Long, vCol As Long
Dim ws As Worksheet, vTitles As String, SvPath As String
Dim MyArr As Range, Supplier As Range
Dim OutApp As Object, OutMail As Object
'On Error GoTo ErrHandl

If ThisWorkbook.Name = ActiveWorkbook.Name Then
    MsgBox "Please activate the data sheet to parse/email and then run this macro. Aborting."
    Exit Sub
End If
Application.ScreenUpdating = False

'Column to evaluate from, column A = 1, B = 2, etc.
   vCol = 4
 
'Sheet with data in it
   Set ws = ActiveSheet

'Path to save files into, remember the final \
    SvPath = ThisWorkbook.Path

'Range where titles are across top of data, as string, data MUST
'have titles in this row, edit to suit your titles locale
    vTitles = "A1:Z1"
   
'Spot bottom row of data
   LR = ws.Cells(ws.Rows.Count, vCol).End(xlUp).Row

'Put list into an array for looping (values cannot be the result of formulas, must be constants)
    Set MyArr = ThisWorkbook.Sheets("Suppliers").Range("A2:A" & Rows.Count).SpecialCells(xlCellTypeConstants)

'Turn on the autofilter, one column only is all that is needed
    ws.AutoFilterMode = False
    ws.Range(vTitles).AutoFilter

'Loop through list one value at a time
    For Each Supplier In MyArr
        ws.Range(vTitles).AutoFilter Field:=vCol, Criteria1:=Supplier.Value
        BR = ws.Cells(ws.Rows.Count, vCol).End(xlUp).Row
        If BR > 1 Then
            ws.Range("A1:A" & BR).EntireRow.Copy
            Workbooks.Add
            Range("A1").PasteSpecial xlPasteAll
            Cells.Columns.AutoFit
            ActiveWorkbook.SaveAs SvPath & ws.Name & " " & Supplier.Offset(, 2) & ".xls", xlNormal
    
            Set OutApp = CreateObject("Outlook.Application")
            Set OutMail = OutApp.CreateItem(0)

            With OutMail
                .Subject = "Weekly Income Statement"
                .To = Supplier.Offset(, 1)
                '.CC =
                .Attachments.Add ActiveWorkbook.FullName
                .Send '.or Display to display
            End With
            
            ActiveWorkbook.Close False
            
            ws.Range(vTitles).AutoFilter Field:=vCol
            Set OutMail = Nothing
            Set OutApp = Nothing
        End If
    Next Supplier

'Cleanup
    ws.AutoFilterMode = False
    Application.ScreenUpdating = True
End Sub