Save active worksheet as new workbook havinf the name of the active sheet

Doflamingo

Board Regular
Joined
Apr 16, 2019
Messages
238
Hi all,

Below is the code to create a new workbook with the active worksheet of an open workbook

Code:
Sub sb_Copy_Save_ActiveSheet_As_Workbook()
        Set wb = Workbooks.Add
    ThisWorkbook.Activate
    ActiveSheet.Copy Before:=wb.Sheets(1)
    wb.Activate
    wb.SaveAs "C:\Users\AtivBook9\Downloads\Reims\test3.xlsx"
End Sub

1, How to rename the workbook with the name of the active sheet ?
2, How to put the newly created workbook having the name of the active worksheet in a new folder created by VBA having the same name than the workbook ?

Any idea ?
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
Because here the name of the workbook newly created is called ''test3'' and I would like it has the name of the active sheet
 
Upvote 0
Try this



Code:
Sub sb_Copy_Save_ActiveSheet_As_Workbook()
     Dim wname as string
     Wname = activesheet.name
    ActiveSheet.Copy
    Activeworkbook.SaveAs "C:\Users\AtivBook9\Downloads\Reims\" & wname & ".xlsx"
End Sub
 
Upvote 0
Do you know how to put the new excel file created in a new folder having the same name than the excel file created ?


Try this

Code:
Sub sb_Copy_Save_ActiveSheet_As_Workbook()
  Dim wname As String, wfolder As String
  wname = ActiveSheet.Name
  wfolder = "C:\Users\AtivBook9\Downloads\Reims\" & wname & "\"
  If Dir(wfolder, vbDirectory) = "" Then
    MsgBox "The folder does not exist! " & wfolder, vbCritical
    Exit Sub
  End If
  ActiveSheet.Copy
  ActiveWorkbook.SaveAs wfolder & wname & ".xlsx"
End Sub
 
Upvote 0
Hello @DanteAmor

Many thanks for your reply. The code you gave me me displays "The folder does not exist! "

because indeed it does not exist... is it possible with VBA to create a new folder and then put the workbook created above with that function I've found on Internet

Code:
Function MkDir(strDir As String, strPath As String)


Dim fso As New FileSystemObject
Dim path As String


'examples for what are the input arguments
'strDir = "Folder"
'strPath = "C:\"


strDir = "folder"
strPath = "C:\Users\AtivBook9\Downloads\Reims\"


path = strPath & strDir


If Not fso.FolderExists(path) Then


' doesn't exist, so create the folder
          fso.CreateFolder path


End If
 
Upvote 0
Because that code
Code:
[COLOR=#333333]Sub sb_Copy_Save_ActiveSheet_As_Workbook()[/COLOR]  Dim wname As String, wfolder As String
  wname = ActiveSheet.Name
  wfolder = "C:\Users\AtivBook9\Downloads\Reims\" & wname & "\"
  If Dir(wfolder, vbDirectory) = "" Then
    MsgBox "The folder does not exist! " & wfolder, vbCritical
    Exit Sub
  End If
  ActiveSheet.Copy
  ActiveWorkbook.SaveAs wfolder & wname & ".xlsx"
End Sub

always displays ''the folder does not exist'' so how to combine the function with that code ? if the folder does not exist then call the function and create a new folder having the name of the active sheet with the new workbook created included into the folder ?
 
Upvote 0
is it possible with VBA to create a new folder and then put the workbook created

Try this

Code:
Sub sb_Copy_Save_ActiveSheet_As_Workbook()
  Dim wname As String, wfolder1 As String, wfolder2 As String
  wname = ActiveSheet.Name
  wfolder1 = "C:\Users\AtivBook9\Downloads\Reims\"
  
  If Right(wfolder1, 1) <> "\" Then wfolder1 = wfolder1 & "\"
  If Dir(wfolder1, vbDirectory) = "" Then
    MsgBox "The folder does not exist! " & wfolder1, vbCritical
    Exit Sub
  End If
  wfolder2 = wfolder1 & wname & "\"
  If Dir(wfolder2, vbDirectory) = "" Then
    MkDir wfolder2
  End If
  
  ActiveSheet.Copy
  ActiveWorkbook.SaveAs wfolder2 & wname & ".xlsx"
End Sub
 
Upvote 0
I'm glad to help you. I appreciate your kind comments.
 
Upvote 0

Forum statistics

Threads
1,213,531
Messages
6,114,167
Members
448,554
Latest member
Gleisner2

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