Microsoft Office

Convert / split excel sheets into new files

Today, I got an e-mail from management with the request (or order, you know how management can be) to perform an unglamorous task.  “Here’s an excel file.  We need you to turn every sheet into a new file.”  Boring!  The Excel File wasn’t that big, but one of the things I was thought at school was to be “functionally lazy”.  In other words, do as little as possible to reach the result you want.

So, I searched for a way to automate this task and, of course, I was succesfull.  I’m not being vain; but I wouldn’t dedicate a post to it if I hadn’t!

Solution

To convert the individual sheets of an excel file into new files, with minimum effort, you can use a VBA code.  I take no credit for it, the code was written by Ron De Bruin , a Microsoft MVP and Excel specialist. 

Here’s what you need to do:

1.  Open the Excel file you want to work with.

2.  Click the Developer tab, or use the Excel 2003 alternative.

3.  Click ‘Visual Basic’. 

4.  In the new window, right-click the project title – the one in bold –, choose ‘Insert’ and ‘Module’.

5.  In the window that opens, post the following code 

 

‘Working in 97-2007

Dim FileExtStr As String

Dim FileFormatNum As Long

Dim Sourcewb As Workbook

Dim Destwb As Workbook

Dim sh As Worksheet

Dim DateString As String

Dim FolderName As String

With Application

.ScreenUpdating = False

.EnableEvents = False

.Calculation = xlCalculationManual

End With

‘Copy every sheet from the workbook with this macro

Set Sourcewb = ThisWorkbook

‘Create new folder to save the new files in

DateString = Format(Now, "yyyy-mm-dd hh-mm-ss")

FolderName = Sourcewb.Path & "\" & Sourcewb.Name & " " & DateString

MkDir FolderName

‘Copy every visible sheet to a new workbook

For Each sh In Sourcewb.Worksheets

‘If the sheet is visible then copy it to a new workbook

If sh.Visible = -1 Then

sh.Copy

‘Set Destwb to the new workbook

Set Destwb = ActiveWorkbook

‘Determine the Excel version and file extension/format

With Destwb

If Val(Application.Version) < 12 Then

‘You use Excel 97-2003

FileExtStr = ".xls": FileFormatNum = -4143

Else

‘You use Excel 2007

If Sourcewb.Name = .Name Then

MsgBox "Your answer is NO in the security dialog"

GoTo GoToNextSheet

Else

Select Case Sourcewb.FileFormat

Case 51: FileExtStr = ".xlsx": FileFormatNum = 51

Case 52:

If .HasVBProject Then

FileExtStr = ".xlsm": FileFormatNum = 52

Else

FileExtStr = ".xlsx": FileFormatNum = 51

End If

Case 56: FileExtStr = ".xls": FileFormatNum = 56

Case Else: FileExtStr = ".xlsb": FileFormatNum = 50

End Select

End If

End If

End With

‘Change all cells in the worksheet to values if you want

If Destwb.Sheets(1).ProtectContents = False Then

With Destwb.Sheets(1).UsedRange

.Cells.Copy

.Cells.PasteSpecial xlPasteValues

.Cells(1).Select

End With

Application.CutCopyMode = False

End If

‘Save the new workbook and close it

With Destwb

.SaveAs FolderName _

& "\" & Destwb.Sheets(1).Name & FileExtStr, _

FileFormat:=FileFormatNum

.Close False

End With

End If

GoToNextSheet:

Next sh

MsgBox "You can find the files in " & FolderName

With Application

.ScreenUpdating = True

.EnableEvents = True

.Calculation = xlCalculationAutomatic

End With

End Sub

6.  Execute the code by clicking the green ‘play’ button. 

7.  The code will start to split up your file.  You might see a few warnings when splitting up an xlsx file regarding the make-up but it won’t cause any real problems. 

8.  You’re done!  You can find the files in a subdirectory of where the original file was located. 

Happy splitting!!

Advertisements