Save my WB based on another workbook name in VBA

Question

I have a code which is doing following:

• Prompt to choose external workbook

• Copying all the data from that wb

• Pasting exactly 1:1 in main wb

• Close and Save from .xlsm to .xlsx but with a name of my main wb

    Sub CopySheetFromClosedWorkbook2()
  
    'Prompt to choose your file in the chosen locatioon
    Dim dialogBox As FileDialog
    Dim FilePath As String
    Set dialogBox = Application.FileDialog(msoFileDialogOpen)
    Application.StatusBar = "Choose older PDS Form!"
  
    dialogBox.AllowMultiSelect = False
    dialogBox.Title = "Select a file"
    If dialogBox.Show = -1 Then
        FilePath = dialogBox.SelectedItems(1)
  
    'If nothing selected then MsgBox
    Else
       MsgBox "No PDS Form selected!"
       Exit Sub
    End If
  
    'Here are sheets defined which you are going to copy/paste (reference update) but to keep formatting.
    ''Sheets should be defined from right to left to have your sheets sorted from the beginning
    Dim shNames As Variant: shNames = Array("CH_or_Recipe_8", "CH_or_Recipe_7", "CH_or_Recipe_6", "CH_or_Recipe_5", "CH_or_Recipe_4", _
    "CH_or_Recipe_3", "CH_or_Recipe_2", "CH_or_Recipe_1", "Customer Details", "Instructions")
  
    Dim tgt As Workbook: Set tgt = ThisWorkbook
    Application.ScreenUpdating = False
    Dim src As Workbook: Set src = Workbooks.Open(FilePath)
    Dim ws As Worksheet, rng As Range, i As Long
  
    For Each ws In src.Sheets
        If ws.Name Like "*[1-8]" Then
            ws.Name = "CH_or_Recipe_" & Right(ws.Name, 1)
        ElseIf ws.Name = "Customer_Details" Then
            ws.Name = "Customer Details"
        ElseIf ws.Name = "OIPT Plasmalab" Then
            ws.Name = "CH_or_Recipe_1"
        ElseIf ws.Name = "AMAT" Then
            ws.Name = "CH_or_Recipe_2"
  
        End If
    Next
  
    For i = 0 To UBound(shNames)
        On Error Resume Next
        Set ws = src.Sheets(shNames(i))
        If Err.Number = 0 Then
            tgt.Worksheets(shNames(i)).Cells.Clear
            Set rng = ws.UsedRange
            rng.Copy tgt.Worksheets(shNames(i)).Range(rng.Address)
        End If
    Next i
    src.Close False
  
    Application.ScreenUpdating = True
    MsgBox "Copy&Paste successful!"
    End Sub
  
  
    Sub SaveNoMacro()
  
    Dim fn As String
    With ThisWorkbook
        fn = Replace(.FullName, ".xlsm", ".xlsx")
         Application.DisplayAlerts = False
        .SaveAs fn, FileFormat:=xlWorkbookDefault
         Application.DisplayAlerts = True
    End With
    MsgBox "Saved as " & fn
  
   End Sub
  

What I just need (if possible) is to save my wb in the same name as that external wb that I am taking data from and adding date/time at the end.

Example:

MainWB1.xlsm + ExternalWB1.xlsx >>> MainWB1.xlsx (This is now)

MainWB1.xlsm + ExternalWB1.xlsx >>> ExternalWB1_today().xlsx (This is what I wanna)

Answer 1

You have 2 separate methods:

• CopySheetFromClosedWorkbook2
• SaveNoMacro

The name of the source workbook is only available in the scope of the CopySheetFromClosedWorkbook2 because that's where you open and close it. So, you have 2 options:

1. Save the main workbook before exiting the scope of the CopySheetFromClosedWorkbook2 method i.e. while the name of the source book is available
2. Save the name of the source book somewhere (global variable, named range, registy, custom xml part etc.) or even return it as a result (Function instead of Sub) so that you can call the SaveNoMacro method at a later stage

Save before exiting the scope

Here are 2 ways to do this:

1. Place your save code before the src.Close False line so that you can use the src.Name property i.e. combine the 2 methods into one. Not sure if you want to do this
2. Pass the name as an argument to the second method. In CopySheetFromClosedWorkbook2 replace this:

src.Close False

with this:

SaveNoMacro src.Name
src.Close False

and update SaveNoMacro to:

Sub SaveNoMacro(ByVal newName As String)
    Dim fn As String
    With ThisWorkbook
        fn = Replace(.FullName, .Name, Left(newName, InStrRev(newName, ".") - 1)) _
           & Format$(Date, "_yyyy-mm-dd") & ".xlsx"
        Application.DisplayAlerts = False
        .SaveAs fn, FileFormat:=xlWorkbookDefault
        Application.DisplayAlerts = True
    End With
    MsgBox "Saved as " & fn
End Sub

Save the name for later use

In case you don't want to run the 2 methods in a sequence then you can save the name for later use. Using a global variable is not a good idea as the state can be lost by the time you run the save method. Using a named range would work as long as you don't have your workbook protected i.e you can create a named range.

There are many options but the easiest to use is to write to registry using the built in SaveSetting option. Replace this:

src.Close False

with this:

SaveSetting "MyApp", "MySection", "NewBookName", src.Name
src.Close False

and update SaveNoMacro to:

Sub SaveNoMacro()
    Dim fn As String: fn = GetSetting("MyApp", "MySection", "NewBookName")
    If LenB(fn) = 0 Then
        MsgBox "No name was saved", vbInformation, "Cancelled"
        Exit Sub
    Else
        DeleteSetting "MyApp", "MySection", "NewBookName"
    End If
    With ThisWorkbook
        fn = Replace(.FullName, .Name, Left(fn, InStrRev(fn, ".") - 1)) _
           & Format$(Date, "_yyyy-mm-dd") & ".xlsx"
        Application.DisplayAlerts = False
        .SaveAs fn, FileFormat:=xlWorkbookDefault
        Application.DisplayAlerts = True
    End With
    MsgBox "Saved as " & fn
End Sub

Answer 2

fn = Replace(.FullName, ".xlsm", ".xlsx")



fn = Replace(.FullName, ".xlsm", date & ".xlsx")

Answer 3

What I just need (if possible) is to save my wb in the same name as that external wb that I am taking data from and adding date/time at the end

You got the full path of your external wb in the variable FilePath so you can use that to save the workbook. You could save it like this (at the end of your sub CopySheetFromClosedWorkbook2):

Dim SaveName As String


SaveName = src.Path & "\" & Replace(Split(Filepath, "\")(UBound(Split(Filepath, "\"))), ".xlsm", Format(Date, "dd_mm_yyyy") & ".xlsx")


With ThisWorkbook
    Application.DisplayAlerts = False
    .SaveAs SaveName, FileFormat:=xlWorkbookDefault
    Application.DisplayAlerts = True
End With

Notice I'm using the object src to get the path where you want to save the new workbook, so you need to asign the line SaveName = .... anywhere before you do src.Close.