VBA Code - Save Worksheet as New Workbook with Certain Name

[shaon814]

Hi,

I'm trying to find a Macro to save the current worksheet I'm into a new workbook.

For example, when the user clicks the "Save Worksheet" Macro button, it'll save the worksheet they're in to a new workbook with

1. The new workbook named with the "old sheet name" + what information is in cell "N2" + "N5"

Any help would very much be appreciated!

-Thank you

Hussain

 

[Logit]

.
Here is one method :

Option Explicit

Sub uuu()
    Dim sFolder$, sFile$, sPath$
'--------------------------------
    sFolder = CreateObject("WScript.Shell").SpecialFolders("Desktop")
    'sFile = Range("c2") & ".xlsm"
    sFile = ActiveSheet.Name & " " & Range("N2") & " " & Range("N5") & " " & ".xlsm"
    sPath = sFolder & Application.PathSeparator & sFile
    ActiveWorkbook.SaveAs sPath
    MsgBox "File Saved to Desktop"
End Sub

 

[Logit]

.
And here is another without carrying over the macro code :

Option Explicit

Sub SveShts()

Dim xPath As String
Dim xWs  As String

xPath = Application.ActiveWorkbook.Path


Application.ScreenUpdating = False
Application.DisplayAlerts = False

With ActiveSheet
    ActiveSheet.Copy
    Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & ActiveSheet.Name & " " & Range("N2").Value & " " & Range("N5").Value & ".xlsx"
    Application.ActiveWorkbook.Close False
End With

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

 

[Norie]

Perhaps something like this which will save the new workbook in the same folder as the workbook the code is run from.

Dim wbNew As Workbook
Dim strFileName As String

    With ActiveSheet
        strFileName = .Name & "-" &  .Range("N2").Value & "-" & .Range("N5").Value
        .Copy
    End With

    Set wbNew = ActiveWorkbook

    wbNew.SaveAs ThisWorkbook.Path & "\" & strFileName, xlOpenXMLWorkbook

 

[Pinaceous]

Perhaps something like this which will save the new workbook in the same folder as the workbook the code is run from.

Dim wbNew As Workbook
Dim strFileName As String

    With ActiveSheet
        strFileName = .Name & "-" &  .Range("N2").Value & "-" & .Range("N5").Value
        .Copy
    End With

    Set wbNew = ActiveWorkbook

    wbNew.SaveAs ThisWorkbook.Path & "\" & strFileName, xlOpenXMLWorkbook

Hi Norie,

In lieu of saving the range as a

xlOpenXMLWorkbook

Can you save it as a notepad?

Please let me know.
Thank you,
Pinaceous

 

[Logit]

My suggestion (#3) posts to Notepad.

 

[Pinaceous]

My suggestion (#3) posts to Notepad.

Hey I tried the post (#3) Notepad extension and the txt notepad came out gibberish.

Sub SveShts()

Dim xPath As String
Dim xWs  As String

xPath = Application.ActiveWorkbook.path


Application.ScreenUpdating = False
Application.DisplayAlerts = False

With ActiveSheet
    ActiveSheet.Copy
    Application.ActiveWorkbook.SaveAs filename:=xPath & "\" & ActiveSheet.Name & " " & range("N2").Value & " " & range("N5").Value & ".txt"
    Application.ActiveWorkbook.Close False
End With

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

 

[Logit]

Interesting ...

 

[rlv01]

Hey I tried the post (#3) Notepad extension and the txt notepad came out gibberish.

Unless I'm missing something, you need to specify the file type using the FileFormat parameter in the SaveAs statement.

Sub SveShts()
    
    Dim xPath As String
    Dim xWs  As String
    Dim xFilename As String
    
    xPath = Application.ActiveWorkbook.Path
    
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    With ActiveSheet
        ActiveSheet.Copy
        xFilename = xPath & "\" & ActiveSheet.Name & " " & Range("N2").Value & " " & Range("N5").Value & ".txt"
        
        Application.ActiveWorkbook.SaveAs Filename:=xFilename, FileFormat:=xlText
        Application.ActiveWorkbook.Close False
    End With
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
End Sub

 

[Pinaceous]

Unless I'm missing something, you need to specify the file type using the FileFormat parameter in the SaveAs statement.

Sub SveShts()
   
    Dim xPath As String
    Dim xWs  As String
    Dim xFilename As String
   
    xPath = Application.ActiveWorkbook.Path
   
   
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
   
    With ActiveSheet
        ActiveSheet.Copy
        xFilename = xPath & "\" & ActiveSheet.Name & " " & Range("N2").Value & " " & Range("N5").Value & ".txt"
       
        Application.ActiveWorkbook.SaveAs Filename:=xFilename, FileFormat:=xlText
        Application.ActiveWorkbook.Close False
    End With
   
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
   
End Sub

Hi rlv01,

WOW! That actually worked perfect!

Curious, just a question to follow, how would I specify a range for the printout?

For example, range A1:AY38?

Thanks,
pinaceous