Excel VBA Macro to copy and save a sheet in a specified folder

[Wingfoot]

Hi

Please could someone look at my code and let me know what I'm doing wrong. I keep getting a runtime error (1004) and it's not saving. The title of the sheet is variable according to its reference number and the current date.

Sub McrCopyAndSave()

    Dim MyFileNameSave As String
       
    MyFolderPathPrefix = "O:\Planning\Team\MT\Packing lists\"
    MyFolderPathDate = Sheets("Pivot").Range("Q1").Value
    MyFileNameSave = MyFolderPathPrefix & MyFolderPathDate
 
    Sheets("Pack list").Select
    Sheets("Pack list").Copy
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("S2").Select
    Application.CutCopyMode = False
    ActiveWorkbook.SaveAs Filename:= _
    MyFileNameSave, _
        FileFormat:=1, CreateBackup:=False
 
    Windows("Packing list.xlsm").Activate
 
End Sub

Many thanks in anticipation!

 

[revcanon]

Here is a snippet I use occasionally. I modified it slightly for your terms.

Test it out... see if you can use it or modify it further for your use.

        MyFileNameSave= Application.GetSaveAsFilename( _
        FileFilter:="Excel Workbook (*.xls*),*.xls*", _
        InitialFileName:= MyFolderPathPrefix & MyFolderPathDate
        Application.EnableEvents = True
            If fileSaveName <> "False" Then
                Application.DisplayAlerts = False
                ActiveWorkbook.SaveAs (MyFileNameSave)
                Application.DisplayAlerts = True
            End If

 

[Wingfoot]

Hi revcanon

Thanks for your reply.

I'm having a bit of trouble geting it to work please see my revised code with yours inserted. It brings up the save as dialogue box in the correct folder but doesn't show the save name. The macro stops at that point too.

Sub McrCopyAndSave()


    Dim MyFileNameSave As String
        
    MyFolderPathPrefix = "O:\Planning\Team\MT\Packing lists\"
    MyFolderPathDate = Sheets("Pivot").Range("Q1").Value
    MyFileNameSave = MyFolderPathPrefix & MyFolderPathDate

    Sheets("Pack list").Select
    Sheets("Pack list").Copy
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("S2").Select
    
     MyFileNameSave = Application.GetSaveAsFilename( _
        FileFilter:="Excel Workbook (*.xls*),*.xls*", _
        InitialFileName:=MyFolderPathPrefix & MyFolderPathDate)
        
        Application.EnableEvents = True
            If fileSaveName <> "False" Then
                Application.DisplayAlerts = False
                ActiveWorkbook.SaveAs (MyFileNameSave)
                Application.DisplayAlerts = True
            End If
    
    'Application.CutCopyMode = False
    'ActiveWorkbook.SaveAs Filename:= _
    'MyFileNameSave, _
    '    FileFormat:=1, CreateBackup:=False

    Windows("Packing list.xlsm").Activate
    
    
End Sub

Thanks

 

[revcanon]

Try this out:

Sub McrCopyAndSave()
    Dim NewName As String
    Dim MyFileNameSave
    Dim wb As Workbook
    Dim wb2 As Workbook
    Set wb = ThisWorkbook
    wb.Activate
    wb.Sheets("Pack list").Select
    wb.Sheets("Pack list").Copy
    Sheets("Pack list").Activate
    Set wb2 = ActiveWorkbook
    wb2.Sheets("Pack list").Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    wb.Activate
    NewName = wb.Sheets("Pivot").Range("Q1").Value
    wb2.Activate
    Application.EnableEvents = False
'This saves as an .xls file... if you need it as .xlsx then change the 3 .xls references below...
    MyFileNameSave = Application.GetSaveAsFilename( _
    FileFilter:="Excel Workbook (*.xls),*.xls", _
    Title:="SAVE FINAL REPORT AS...", _
    InitialFileName:="O:\Planning\Team\MT\Packing lists\" & NewName & ".xls")
    Application.EnableEvents = True
        If MyFileNameSave <> "False" Then
            Application.DisplayAlerts = False
            FinalReport.SaveAs (MyFileNameSave), FileFormat:=xlOpenXMLWorkbook
            Application.DisplayAlerts = True
        End If
    Windows("Packing list.xlsm").Activate
End Sub

I added a few designations for the workbooks to keep myself straight.
Not sure why, but i could not get it to populate the name if i excluded the file filter.
So adjust the file filter type for your needs.

As always... TEST ON A COPY

 

[Wingfoot]

That's great - many thanks for your help