Split Worksheets into Separate Files

Split Worksheets into Separate Files

[vb autolinks=”false” classname=”myclass” collapse=”false” firstline=”1″ gutter=”true” highlight=”” htmlscript=”false” light=”false” padlinenumbers=”false” smarttabs=”true” tabsize=”4″ toolbar=”true” title=”Split Sheets to Files”]
Sub BreakItUp()
Dim sht As Worksheet
Dim newFileName As String
Const workBookPath = "c:\dl\"

For Each sht In ActiveWorkbook.workSheets
sht.Copy
newFileName = workBookPath & sht.Name & ".xls"
ActiveWorkbook.SaveAs FileName:=newFileName, _
FileFormat:=xlNormal, CreateBackup:=False
ActiveWindow.Close
Next
End Sub
[/vb]

Use the following macro to take workbooks with many sheets and split them into seperate workbooks. This leavs the initial file intact and creates the individual files and then shuts closes them. You also have the ability to add a prefix and/or suffix to th new workbook name.

[vb autolinks=”false” classname=”myclass” collapse=”false” firstline=”1″ gutter=”true” highlight=”” htmlscript=”false” light=”false” padlinenumbers=”false” smarttabs=”true” tabsize=”4″ toolbar=”true” title=”Split Sheets to Files 2″]
Sub TabsToXlsxFiles()

‘Creates an individual workbook for each worksheet in the active workbook.
Dim wbDest As Workbook
Dim wbSource As Workbook
Dim sht As Object ‘Could be chart, worksheet, Excel 4.0 macro,etc.
Dim strSavePath As String
Dim filePrefix As String
filePrefix = inputBox("Enter File Prefix if any desired (a space will separate the _
prefix and the sheet name)", "File Prefix", "", 550, 550)
fileSuffix = inputBox("Enter File Suffix if any desired (a space will separate the _
sheet name from the suffix)", "File Suffix", "", 550, 550)

On Error GoTo ErrorHandler

Application.ScreenUpdating = False ‘Don’t show any screen movement

strSavePath = "C:\DL\excelsplits\" ‘Change this to suit your needs

Set wbSource = ActiveWorkbook

For Each sht In wbSource.Sheets
sht.Copy
Set wbDest = ActiveWorkbook
wbDest.SaveAs strSavePath & filePrefix & " " & sht.Name & " " & fileSuffix
wbDest.Close ‘Remove this if you don’t want each book closed after saving.
Next

Application.ScreenUpdating = True

Exit Sub

ErrorHandler: ‘Just in case something bad happens
MsgBox "An error has occurred. Error number=" & Err.number & _
". Error description=" & Err.Description & "."
End Sub
[/vb]