Excel VBA open & save as - vba

Question

I have managed to open a series of excel workbooks based on values in cells, but am struggling to programme the save as. Can you help me to enable save as after opening each workbook?
I want the file name linked to two cells and the file path derived from a cell using =LEFT(CELL("filename"),SEARCH("[",CELL("filename"))-1)
Sub Open_Workbooks()
Dim SourcePath As String
Dim SourceFile1 As String
Dim SourceFile2 As String
Dim bIsEmpty As Boolean
Dim relativePath As String
Dim sname1 As String
Dim sname2 As String
Dim Ret1
Dim Ret2
Dim PathName1 As String
Dim PathName2 As String
SourcePath = "G:\x\y\"
SourceFile1 = Workbooks("r.xlsm").Sheets("Front sheet").Range("Z1").Text
SourceFile2 = Workbooks("r.xlsm").Sheets("Front sheet").Range("Z2").Text
sname1 = Workbooks("r.xlsm").Sheets("Front sheet").Range("AA1").Text
sname2 = Workbooks("r.xlsm").Sheets("Front sheet").Range("AA2").Text
Ret1 = IsWorkBookOpen("G:\x\y\TEMPLATE.xlsm")
Ret2 = IsWorkBookOpen("G:\x\y\TEMPLATE2.xlsm")
relativePath = Workbooks("r.xlsm").Sheets("Front sheet").Range("H13").Text
PathName1 = Workbooks("r.xlsm").Sheets("Front sheet").Range("H13").Text & Workbooks("r.xlsm").Sheets("Front sheet").Range("AA1").Text & "xlsm"
PathName2 = relativePath & sname2 & "xlsm"
bIsEmpty = False
If IsEmpty(Workbooks("r.xlsm").Sheets("Front sheet").Range("Z1")) = False Then
'Workboks.Open "G:\x\y\" & Range("[wardchart]").Text & Range("[code]").Text & ".xlsm", ReadOnly:=True
Workbooks.Open SourcePath & SourceFile1 & ".xlsm", ReadOnly:=False
ElseIf IsEmpty(Workbooks("Rates, percentages calculator.xlsm").Sheets("Front sheet").Range("Z1")) = True Then
bIsEmpty = True
End If
On Error Resume Next
If Ret1 = True Then
'ThisWorkbook.SaveAs PathName1, xlOpenXMLMacroEnabled, CreateBackup:=False
ThisWorkbook.SaveCopyAs PathName1
ElseIf Ret1 = False Then
bIsEmpty = True
End If
On Error Resume Next
End Sub

Answer 1

I resolved this with a file copy to path and then a subsequent open:
Sub CopyRenameFile()
Dim src As String, dst As String, f1 As String, f2 As String
Dim rf1 As String, rf2 As String
'source directory
src = Workbooks("r.xlsm").Sheets("Front sheet").Range("AC1").Text
'destination directory
dst = Workbooks("r.xlsm").Sheets("Front sheet").Range("AB1").Text
'file name
f1 = Workbooks("r.xlsm").Sheets("Front sheet").Range("Z1").Text
'file name
f2 = Workbooks("r.xlsm").Sheets("Front sheet").Range("Z2").Text
'rename file
rf1 = Workbooks("r.xlsm").Sheets("Front sheet").Range("AA1").Text
'rename file
rf2 = Workbooks("r.xlsm").Sheets("Front sheet").Range("AA2").Text
On Error Resume Next
If IsEmpty(Workbooks("r.xlsm").Sheets("Front sheet").Range("Z1")) = False Then
FileCopy src & f1 & ".xlsm", dst & rf1 & ".xlsm"
End If
On Error GoTo 0
On Error Resume Next
If IsEmpty(Workbooks("r.xlsm").Sheets("Front sheet").Range("Z2")) = False Then
FileCopy src & f2 & ".xlsm", dst & rf2 & ".xlsm"
End If
On Error GoTo 0
End Sub

Answer 2

I'm not completely sure whether I could help you with this issue but perhaps this might help getting you in the right direction:
Sub Copy_ActiveSheet_1()
'Working in Excel 97-2017
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Sourcewb = ActiveWorkbook
'Copy the sheet to a new workbook
ActiveSheet.Copy
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 if you want
' With Destwb.Sheets(1).UsedRange
' .Cells.Copy
' .Cells.PasteSpecial xlPasteValues
' .Cells(1).Select
' End With
' Application.CutCopyMode = False
'Save the new workbook and close it
TempFilePath = Application.DefaultFilePath & "\"
TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "yyyy-mm-dd hh-mm-ss")
With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
.Close SaveChanges:=False
End With
MsgBox "You can find the new file in " & TempFilePath
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Sub Copy_ActiveSheet_2()
'Working in Excel 2000-2016
Dim fname As Variant
Dim NewWb As Workbook
Dim FileFormatValue As Long
'Check the Excel version
If Val(Application.Version) < 9 Then Exit Sub
If Val(Application.Version) < 12 Then
'Only choice in the "Save as type" dropdown is Excel files(xls)
'because the Excel version is 2000-2003
fname = Application.GetSaveAsFilename(InitialFileName:="", _
filefilter:="Excel Files (*.xls), *.xls", _
Title:="This example copies the ActiveSheet to a new workbook")
If fname <> False Then
'Copy the ActiveSheet to new workbook
ActiveSheet.Copy
Set NewWb = ActiveWorkbook
'We use the 2000-2003 format xlWorkbookNormal here to save as xls
NewWb.SaveAs fname, FileFormat:=-4143, CreateBackup:=False
NewWb.Close False
Set NewWb = Nothing
End If
Else
'Give the user the choice to save in 2000-2003 format or in one of the
'new formats. Use the "Save as type" dropdown to make a choice,Default =
'Excel Macro Enabled Workbook. You can add or remove formats to/from the list
fname = Application.GetSaveAsFilename(InitialFileName:="", filefilter:= _
" Excel Macro Free Workbook (*.xlsx), *.xlsx," & _
" Excel Macro Enabled Workbook (*.xlsm), *.xlsm," & _
" Excel 2000-2003 Workbook (*.xls), *.xls," & _
" Excel Binary Workbook (*.xlsb), *.xlsb", _
FilterIndex:=2, Title:="This example copies the ActiveSheet to a new workbook")
'Find the correct FileFormat that match the choice in the "Save as type" list
If fname <> False Then
Select Case LCase(Right(fname, Len(fname) - InStrRev(fname, ".", , 1)))
Case "xls": FileFormatValue = 56
Case "xlsx": FileFormatValue = 51
Case "xlsm": FileFormatValue = 52
Case "xlsb": FileFormatValue = 50
Case Else: FileFormatValue = 0
End Select
'Now we can create/Save the file with the xlFileFormat parameter
'value that match the file extension
If FileFormatValue = 0 Then
MsgBox "Sorry, unknown file extension"
Else
'Copies the ActiveSheet to new workbook
ActiveSheet.Copy
Set NewWb = ActiveWorkbook
'Save the file in the format you choose in the "Save as type" dropdown
NewWb.SaveAs fname, FileFormat:= _
FileFormatValue, CreateBackup:=False
NewWb.Close False
Set NewWb = Nothing
End If
End If
End If
End Sub