
Sub SaveActiveWorksheetToSeparateFile()
We will write the code inside this subject procedure.
Dim File_Ext, Location As String
Dim File_Format As Long
Dim wsh As Worksheet
Dim wkb, Nwkb As Workbook
Declaring necessary variables.
Application.ScreenUpdating = False
It makes VBA work in the background. As a result, VBA works faster.
Set wkb = Application.ThisWorkbook
Set wsh = ActiveSheet
DtStr = Format(Now, “dd-mm-yyyy hh-mm-ss”)
Location = wkb.Path & “\” & wkb.Name & ” ” & DtStr
It sets values to the variables.
If Val(Application.Version) < 12 Then
File_Ext = “.xls”: File_Format = -4143
Else
Select Case wkb.FileFormat
Case 51:
File_Ext = “.xlsx”: File_Format = 51
Case 52:
If Application.ActiveWorkbook.HasVBProject Then
File_Ext = “.xlsm”: File_Format = 52
Else
File_Ext = “.xlsx”: File_Format = 51
End If
Case 56:
File_Ext = “.xls”: File_Format = 56
Case Else:
File_Ext = “.xlsb”: File_Format = 50
End Select
End If
Identifying the file format of the original workbook.
MkDir Location
Creates a new folder.
With wsh
Works with the active worksheet.
On Error GoTo Error
Goes to the referred statement in case of errors.
wsh.Copy
Copies the active worksheet.
xFile = Location & “\” & wsh.Name & File_Ext
Set Nwkb = Application.Workbooks.Item(Application.Workbooks.Count)
Nwkb.SaveAs xFile, FileFormat:=File_Format
Nwkb.Close False, xFile
Creates the new file and then saves and closes it.
End With
Stops working with the worksheet.
Error:
The code runs from here if any error occurs with the active worksheet.
wkb.Activate
The original workbook becomes activated.
MsgBox “The file is in ” & Location
A message box displays the location of the newly created file.
Application.ScreenUpdating = True
Screen updating is set to defaults.
End Sub
The subject procedure ends here.
Use the following code to save all of the worksheets to separate files in Excel.
Sub SaveAllWorksheetsToSeparateFiles() Dim File_Ext, Location As String Dim File_Format As Long Dim wsh As Worksheet Dim wkb, Nwkb As Workbook Application.ScreenUpdating = False Set wkb = Application.ThisWorkbook DtStr = Format(Now, "dd-mm-yyyy hh-mm-ss") Location = wkb.Path & "\" & wkb.Name & " " & DtStr If Val(Application.Version) < 12 Then File_Ext = ".xls": File_Format = -4143 Else Select Case wkb.FileFormat Case 51: File_Ext = ".xlsx": File_Format = 51 Case 52: If Application.ActiveWorkbook.HasVBProject Then File_Ext = ".xlsm": File_Format = 52 Else File_Ext = ".xlsx": File_Format = 51 End If Case 56: File_Ext = ".xls": File_Format = 56 Case Else: File_Ext = ".xlsb": File_Format = 50 End Select End If MkDir Location For Each wsh In wkb.Worksheets On Error GoTo Error If wsh.Visible = xlSheetVisible Then wsh.Select wsh.Copy xFile = Location & "\" & wsh.Name & File_Ext Set Nwkb = Application.Workbooks.Item(Application.Workbooks.Count) Nwkb.SaveAs xFile, FileFormat:=File_Format Nwkb.Close False, xFile End If Error: wkb.Activate Next MsgBox "The files are in " & Location Application.ScreenUpdating = True End Sub
Download Practice Workbook
Save Worksheet to Separate File.xlsm