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