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

[Doflamingo]

Hi all,

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

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 ?

 

[Doflamingo]

Because here the name of the workbook newly created is called ''test3'' and I would like it has the name of the active sheet

 

[DanteAmor]

Try this

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

 

[Doflamingo]

Hello @DanteAmor

Many thanks for your reply, that works

Do you know how to put the new excel file created in a new folder having the same name than the excel file created ?

 

[DanteAmor]

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

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

 

[Doflamingo]

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

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

 

[Doflamingo]

Because that 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 ?

 

[DanteAmor]

is it possible with VBA to create a new folder and then put the workbook created

Try this

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

 

[Doflamingo]

So many Thanks @DanteAmor !!

That works perfectly

Thanks a lot for your time and your help on that issue.

Kind regards

 

[DanteAmor]

I'm glad to help you. I appreciate your kind comments.