Subdivide worksheets and send with macros

Hi,

I have about 30 departments that I send month end information to in Excel. I have a Macro that divides the spreadsheets and sends each one through Microsoft Outlook to the destination email address. In the process of sending the worksheet it appears that the Macros don't send with the worksheet. I would like to send the other Macros I have programed with the worksheet. Below is the Subdivide and send macro. Any suggestions....

Sub Outlook_Mail_Every_Worksheet()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strdate As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
    For Each ws In ThisWorkbook.Worksheets
        If ws.Range("a1").Value Like "?*@?*.?*" Then
            strdate = Format(Now, "dd-mm-yy h-mm-ss")
            ws.Copy
            Set wb = ActiveWorkbook
            With wb
                .SaveAs "Sheet " & ws.Name & " of " _
                      & ThisWorkbook.Name & " " & strdate & ".xls"
                 Set OutMail = OutApp.CreateItem(0)
                With OutMail
                    .To = ws.Range("a1").Value
                    .CC = ws.Range("b1").Value
                    .Subject = "July 2008 Budget Statement"
                                     
                    .Attachments.Add wb.FullName
                    .Send
                End With
                .ChangeFileAccess xlReadOnly
                Kill .FullName
                .Close False
            End With
            Set OutMail = Nothing
        End If
    Next ws
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub