Macro - That can save a file called "Master pack" and save a copy of this file in the same location with a new name picked from cell in active wb

[Luke1690]

Morning guys, really need help with this one been looking every where for a solution.

i need a macro that can save a copy of a file "Master pack" and then save a copy of that file, renaming it with a cell value.

please if someone could point me in the right direction or give me the code.

would really appreciate it.

 

[dmt32]

Hi
use the SaveCopyAs method

Workbook.SaveCopyAs method (Excel)

Office VBA reference topic

learn.microsoft.com

Dave

 

[Cantrecallmyusername]

Something like the below might work....
This saves the file in a directory as defined with a Year/Month Structure, if not needed drop FromatDate in CheminDest

Sub MasterPack()
Dim WS As Worksheet, CheminDest As String, fNAME As String

'create directories as needed
    On Error Resume Next
    CheminDest = "C:\Users\add_your_directory_here" & Year(Date) & "\"  
    MkDir CheminDest
    CheminDest = CheminDest & Format(Date, "MMM YY") & "\" 
    MkDir CheminDest
    On Error GoTo 0

    fNAME = Range("D1") - 'This will take the value in Cell D1 and use this for the file name

'Copies the sheets to a new workbook:
    Sheets(Array("Sheet1", "Sheet2")).Copy
    Sheets("Sheet1").Name = "SomethingElse"
    Sheets("Sheet2").Name = "SomethingElse2"

    With ActiveWorkbook
        For Each WS In .Worksheets  'Goes through each worksheet in new workbook
        'Writes the values
        Next WS
        
        
        .SaveAs Filename:=CheminDest & fNAME & Format(Date, "yyyymmdd") & ".xls"
        .Close False
    End With
        
    MsgBox "Text file has been saved ", vbInformation, "Data backup"

End Sub

 

[Luke1690]

Something like the below might work....
This saves the file in a directory as defined with a Year/Month Structure, if not needed drop FromatDate in CheminDest

Sub MasterPack()
Dim WS As Worksheet, CheminDest As String, fNAME As String

'create directories as needed
    On Error Resume Next
    CheminDest = "C:\Users\add_your_directory_here" & Year(Date) & "\" 
    MkDir CheminDest
    CheminDest = CheminDest & Format(Date, "MMM YY") & "\"
    MkDir CheminDest
    On Error GoTo 0

    fNAME = Range("D1") - 'This will take the value in Cell D1 and use this for the file name

'Copies the sheets to a new workbook:
    Sheets(Array("Sheet1", "Sheet2")).Copy
    Sheets("Sheet1").Name = "SomethingElse"
    Sheets("Sheet2").Name = "SomethingElse2"

    With ActiveWorkbook
        For Each WS In .Worksheets  'Goes through each worksheet in new workbook
        'Writes the values
        Next WS
       
       
        .SaveAs Filename:=CheminDest & fNAME & Format(Date, "yyyymmdd") & ".xls"
        .Close False
    End With
       
    MsgBox "Text file has been saved ", vbInformation, "Data backup"

End Sub

I've found somthing that works for me I will post the code soon. Thank you for your response though