'Module:    basSplitWorkbooks
'Purpose:   Split a workbook with many sheets into many workbooks with one
'           sheet. Needs basFile module in the same workbook.
'Version:   Excel 97 SR-1
'
Option Explicit
'
'Purpose:   Splits many workbooks
'
Sub SplitAllWorkbooks()
Attribute SplitAllWorkbooks.VB_Description = "Macro recorded 10/12/2001 by David Crawford"
Attribute SplitAllWorkbooks.VB_ProcData.VB_Invoke_Func = " \n14"

    SplitWorkbook "P:\Finance\Operations\1010\Total.xls"
    SplitWorkbook "P:\Finance\Operations\1040\Total.xls"
    SplitWorkbook "P:\Finance\Operations\1050\Total.xls"
    SplitWorkbook "P:\Finance\Operations\1060\Total.xls"
    SplitWorkbook "P:\Finance\Operations\1070\Total.xls"
    SplitWorkbook "P:\Finance\Operations\1080\Total.xls"
    SplitWorkbook "P:\Finance\Operations\1090\Total.xls"
    SplitWorkbook "P:\Finance\Operations\1100\Total.xls"
        
End Sub
'
'Purpose:   Splits one workbook
'
Sub SplitWorkbook(WorkbookPath As String)

    Dim Sheet As Object
    Dim WorkbookDirectory As String
    
    'Get workbook directory
    WorkbookDirectory = GetDirectory(WorkbookPath)
    
    'Open workbook
    Workbooks.Open FileName:=WorkbookPath, UpdateLinks:=0
    
    'For each sheet in workbook
    For Each Sheet In ActiveWorkbook.Sheets
    
        'If sheet is not called TOTAL
        If UCase(Sheet.Name) <> "TOTAL" Then
            
            'Copy sheet to new workbook
            Sheet.Activate
            Sheet.Select
            Cells.Select
            Selection.Copy
            Workbooks.Add
            Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
                False, Transpose:=False
            Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
                False, Transpose:=False
                
            'Save new workbook with name of sheet
            Application.DisplayAlerts = False
            ActiveWorkbook.Close _
                savechanges:=True, _
                FileName:=WorkbookDirectory & "\" & Sheet.Name
            Application.DisplayAlerts = True
          
        End If
        
    Next Sheet
    
    'Close workbook
    ActiveWorkbook.Close savechanges:=False
    
End Sub