VBA - Save each sheet as new workbook with sheet name

Prish

Board Regular
Joined
Mar 30, 2016
Messages
91
Can anyone help me with the following code i wrote:

It only saves the first sheet.

Code:
Sub copysheet()

Dim ws As Worksheet


For Each ws In ThisWorkbook.Worksheets


ActiveSheet.Copy


wb_name = ActiveSheet.Name


Application.DisplayAlerts = False


ActiveWorkbook.SaveAs Filename:= _
"C:\Users\Username\Desktop\" & wb_name & " Budget " & Format(Date, "dd-mm-yy") & ".xlsx", FileFormat:=51


ActiveWorkbook.Close


Application.DisplayAlerts = True


Next ws


End Sub

Edit: I figured it out - change activesheet.copy to ws.copy
 
Last edited:

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
It is correct, change activesheet by ws

Code:
Sub copysheet()
    Dim ws As Worksheet
    Application.DisplayAlerts = False
    For Each ws In ThisWorkbook.Worksheets
        ws.Copy
        wb_name = ws.Name
        ActiveWorkbook.SaveAs Filename:= _
            "C:\Users\Username\Desktop\" & wb_name & " Budget " & Format(Date, "dd-mm-yy") & ".xlsx", FileFormat:=51
        ActiveWorkbook.Close
    Next ws
    Application.DisplayAlerts = True
End Sub
 
Upvote 0
It is correct, change activesheet by ws

Code:
Sub copysheet()
    Dim ws As Worksheet
    Application.DisplayAlerts = False
    For Each ws In ThisWorkbook.Worksheets
        ws.Copy
        wb_name = ws.Name
        ActiveWorkbook.SaveAs Filename:= _
            "C:\Users\Username\Desktop\" & wb_name & " Budget " & Format(Date, "dd-mm-yy") & ".xlsx", FileFormat:=51
        ActiveWorkbook.Close
    Next ws
    Application.DisplayAlerts = True
End Sub

Hi DanteAmor,

Thanks for this VBA.

I wanted to add a folder picker in this code which can pick a .xlsx file and show a "Complete" popup after operation completes. Also I would like to add input from the user about specifying the folder where the operated files will be saved.


Please guide what to correct in the following code:

VBA Code:
Private Sub CommandButton1_Click()
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim i As Integer, j As Integer, f As Integer, s1 As String, s2 As String, ro As Integer, col As Integer, row As Integer, s As Integer, r As Integer
Dim m As Integer, mm As Integer
'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

'Retrieve Target Folder Path From User
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With
    
'In Case of Cancel
NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings

'Target File Extension (must include wildcard "*")
  myExtension = "*.xlsx*"

Sub copysheet()
    Dim ws As Worksheet
    Application.DisplayAlerts = False
    For Each ws In ThisWorkbook.Worksheets
        ws.Copy
        wb_name = ws.Name
        ActiveWorkbook.SaveAs Filename:= _
            "C:\Users\Lenovo Laptop\Desktop\" & wb_name & ".xlsx", FileFormat:=51
        ActiveWorkbook.Close
    Next ws
    Application.DisplayAlerts = True
End Sub
'Message Box when tasks are completed
  MsgBox "Task Complete!"

Thanks ! :)
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,251
Members
448,556
Latest member
peterhess2002

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top