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