Saving Newly Created Workbook in 2 places

Athopp

New Member
Joined
Jul 12, 2022
Messages
12
Office Version
  1. 365
Platform
  1. Windows
Hi All,
I wrote some code that is intended to copy and paste values into a new workbook; save the workbook in a specified folder and also save it in another folder selected by the user. For some reason, my code is giving me trouble at the 'SaveAs' part. Anyone have ideas on how to fix it?

Sub Saving_Tracker()

Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim FilePath As String
Dim FileName As String
Dim sFileSaveName As Variant

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set Sourcewb = ActiveWorkbook

'Copy the ActiveSheet to a new workbook
ActiveSheet.Cells.Copy
Workbooks.Add
ActiveCell.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ActiveCell.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Set Destwb = ActiveWorkbook

'Determine the Excel version and file extension/format
With Destwb
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2016
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End With

'Change all cells in the worksheet to values
With Destwb.Sheets(1).UsedRange
.Cells.Copy
.Cells.PasteSpecial xlPasteValues
'.Cells(1).Select
End With

'Save meeting tracker in repository
FileName = "Tracker for " & Range("BO8").Value & " Saved on " & Format(Now, "mmm-dd-yyyy")
FilePath = "G:\MadeUpFolderName\AnotherFolder\" & ".xlsm"

ActiveWorkbook.SaveAs FileName:=FilePath & "\" & FileName
sFileSaveName = Application.GetSaveAsFilename(InitialFileName:=FileName, fileFilter:="Excel Files (*.xlsm), *.xlsm")

If sFileSaveName <> False Then
ActiveWorkbook.SaveAs sFileSaveName
End If
End Sub
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
Hi there

Does

VBA Code:
sFileSaveName = Application.GetSaveAsFilename(InitialFileName:=FileName, fileFilter:="Excel Files (*.xlsm), *.xlsm")

need to be in format xlsm?
 
Upvote 0

Forum statistics

Threads
1,223,227
Messages
6,170,848
Members
452,361
Latest member
d3ad3y3

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
Back
Top