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

Wingfoot

New Member
Joined
Oct 10, 2014
Messages
37
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.

Code:
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!
 

Some videos you may like

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.

revcanon

Board Regular
Joined
Mar 26, 2015
Messages
173
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.



Code:
        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

New Member
Joined
Oct 10, 2014
Messages
37
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.

Code:
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

Board Regular
Joined
Mar 26, 2015
Messages
173
Try this out:

Code:
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
 

Watch MrExcel Video

Forum statistics

Threads
1,122,499
Messages
5,596,515
Members
414,074
Latest member
Matthew Kakde

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top