In Microsoft Excel, when you want create a new excel file from your current worksheet, just need right-click and select move/copy a sheet. However, if your workbook has many sheets, it take more time.
Now, we show you how to save your time by doing that automatically.
- Create the Visual Basic module
- Open your excel file. Browse to Developer tab and click View code
- Click Insert > Module
- Copy below code into editor
- Run the module
- Click Run button or press F5
- Wait for seconds until to be show the complete message box.
- Click OK to view the result.
Sub SplitWorksheetsIntoFiles()
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim xWs As Worksheet
Dim xWb As Workbook
Dim xNWb As Workbook
Dim FolderName As String
Application.ScreenUpdating = False
Set xWb = Application.ThisWorkbook
DateString = Format(Now, "yyyymmdd-hhmmss")
FolderName = xWb.Path & "\" & xWb.Name & "+" & DateString
If Val(Application.Version) < 12 Then
FileExtStr = ".xls": FileFormatNum = -4143
Else
Select Case xWb.FileFormat
Case 51:
FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If Application.ActiveWorkbook.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
MkDir FolderName
For Each xWs In xWb.Worksheets
On Error GoTo NErro
If xWs.Visible = xlSheetVisible Then
xWs.Select
xWs.Copy
xFile = FolderName & "\" & xWs.Name & FileExtStr
Set xNWb = Application.Workbooks.Item(Application.Workbooks.Count)
xNWb.SaveAs xFile, FileFormat:=FileFormatNum
xNWb.Close False, xFile
End If
NErro:
xWb.Activate
Next
MsgBox "The files in " & FolderName
Application.ScreenUpdating = True
Shell "C:\WINDOWS\explorer.exe """ & Foldername & "", vbNormalFocus
End Sub
Watch the step by step video here:
Comments
Post a Comment