Email Excel Tabs Macro

[mnentertain]

I need a macro that sends each tab in the worksheet to an email address listed in the cell of that worksheet. If it doesn't then I need the tab to be skipped. I also need the worksheets that have been sent to be saved in a specific folder in different files and the tabs that haven't been emailed to also be saved in separate files in another folder. Really appreciate any help.

 

[ParamRay]

.
.

Try something like this:

Sub Call_Sub()

    Call SaveAndEmailWorksheets(ActiveWorkbook)

End Sub

'----------------------------------------------------------------------

Function bIsEmailAddress(sEmailAddress As String) As Boolean

    'returns TRUE if the argument is a
    'valid email address and FALSE if not

    Dim vComponents As Variant
    vComponents = Split(sEmailAddress, "@")
    
    If UBound(vComponents) <> 1 Then
        bIsEmailAddress = False
    ElseIf InStr(1, vComponents(1), ".") = 0 Then
        bIsEmailAddress = False
    Else
        bIsEmailAddress = True
    End If

End Function

'----------------------------------------------------------------------

Sub SaveAndEmailWorksheets(wkbParent As Workbook)

    'Copies a worksheet into one folder if the specified cell
    'contains an email address and another folder if not.
    
    'Also emails a worksheet to its recipient if there is
    'indeed an email address in the specified cell.

    Const sEMAIL_CELL As String = "A1"
    Const sSAVE_PATH_1 As String = "C:\Users\Greg\Desktop\Folder1\"
    Const sSAVE_PATH_2 As String = "C:\Users\Greg\Desktop\Folder2\"
    
    Dim wksToSave As Worksheet
    Dim sSavePath As String
    Dim bSendMail As Boolean
    
    For Each wksToSave In wkbParent.Worksheets
        
        bSendMail = bIsEmailAddress( _
            wksToSave.Range(sEMAIL_CELL).Value)
        
        If bSendMail Then
            sSavePath = sSAVE_PATH_1
        Else
            sSavePath = sSAVE_PATH_2
        End If
        
        wksToSave.Copy
        
        Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs _
            Filename:=sSavePath & wksToSave.Name & ".xlsx", _
            FileFormat:=xlOpenXMLWorkbook
        Application.DisplayAlerts = True
        
        If bSendMail Then
            ActiveWorkbook.SendMail _
                Recipients:=Range(sEMAIL_CELL).Value, _
                Subject:=ActiveWorkbook.Name
        End If
        
        ActiveWorkbook.Close
        
    Next wksToSave

End Sub