Spit a workbook into multiple workbooks, while retaining the macros

I have used the code below to split a workbook by the values in column A. This has worked to retain some of the formatting, formulas and list names. However, it does not retain the macro I have behind the sheet I am splitting (sheet1). Does anyone know whether it is possible (with this code, modified somewhat, or another VBA script) to split a workbook by a column into multiple workbooks (.xlsm in this case) and retain the macros behind sheet1 in all the resulting workbooks? I have found a way to save as .xlsm by specifying: "FileFormat:= 52" in place of "XlNormal," but this does not keep the macros.

Sub ParseItems() 
     '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, Itm As Long, MyCount As Long, vCol As Long 
    Dim ws As Worksheet, MyArr As Variant, vTitles As String, SvPath As String 
     
     'Sheet with data in it
    Set ws = Sheets("Sheet1") 
     
     'Path to save files into, remember the final \
    SvPath = "C:\File\Files\" 
     
    vTitles = "A1:G1" 
     
    vCol = 1 
     
    LR = ws.Cells(ws.Rows.Count, vCol).End(xlUp).Row 
    Application.ScreenUpdating = False 
     
    ws.Columns(vCol).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ws.Range("EE1"), Unique:=True 
     
    ws.Columns("EE:EE").Sort Key1:=ws.Range("EE2"), Order1:=xlAscending, Header:=xlYes, _ 
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal 
     
    MyArr = Application.WorksheetFunction.Transpose(ws.Range("EE2:EE" & Rows.Count).SpecialCells(xlCellTypeConstants)) 
     
    ws.Range("EE:EE").Clear 
     
    ws.Range(vTitles).AutoFilter 
     
    For Itm = 1 To UBound(MyArr) 
        ws.Range(vTitles).AutoFilter Field:=vCol, Criteria1:=MyArr(Itm) 
         
        ws.Range("A1:A" & LR).EntireRow.Copy 
        Workbooks.Add 
        Range("A1").PasteSpecial xlPasteAll 
        Cells.Columns.AutoFit 
        MyCount = MyCount + Range("A" & Rows.Count).End(xlUp).Row - 1 
         
        ActiveWorkbook.SaveAs SvPath & MyArr(Itm) & " Exception Form", xlNormal 
        ActiveWorkbook.Close True 
         
        ws.Range(vTitles).AutoFilter Field:=vCol 
    Next Itm 
     
    ws.AutoFilterMode = False 
    MsgBox "Rows with data: " & (LR - 1) & vbLf & "Rows copied to other sheets: " & MyCount & vbLf & "Hope they match!!" 
    Application.ScreenUpdating = True 
     
End Sub