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

Doflamingo

Board Regular
Joined
Apr 16, 2019
Messages
235
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 ?
 

Doflamingo

Board Regular
Joined
Apr 16, 2019
Messages
235
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

Well-known Member
Joined
Dec 3, 2018
Messages
8,790
Office Version
2007
Platform
Windows
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
 

Doflamingo

Board Regular
Joined
Apr 16, 2019
Messages
235
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

Well-known Member
Joined
Dec 3, 2018
Messages
8,790
Office Version
2007
Platform
Windows
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
 

Doflamingo

Board Regular
Joined
Apr 16, 2019
Messages
235
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
 

Doflamingo

Board Regular
Joined
Apr 16, 2019
Messages
235
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 ?
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
8,790
Office Version
2007
Platform
Windows
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
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
8,790
Office Version
2007
Platform
Windows
I'm glad to help you. I appreciate your kind comments.
 

Forum statistics

Threads
1,081,863
Messages
5,361,743
Members
400,654
Latest member
Pinaki Chatterjee

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top