How to use VBA to copy a filename of an Excel workbook opened with VBA and use it in a save-as function for current workbook?

Question

I have a set of workbooks that contain data that needs to be copied to a new version of the workbook. I found a macro that I added to the new workbook that will open the open file dialogue to allow you to select a file. It then opens the file, copies specific cells to the new workbook and then closes the workbook.

Sub CopyDataToNewWB()
    Dim FileToOpen As Variant
    Dim OpenBook As Workbook
    
    Application.ScreenUpdating = False

        FileToOpen = Application.GetOpenFilename(Title:="Copy Data", FileFilter:="Excel Files (*.xls*),*xls*")
        
                            
            If FileToOpen <> False Then
                Set OpenBook = Application.Workbooks.Open(FileToOpen)
                OpenBook.Sheets(1).Range("A5:o199").Copy
                ThisWorkbook.Worksheets("Calculator").Range("A5").PasteSpecial xlPasteValues
                OpenBook.Sheets(1).Range("AO5:AR34").Copy
                ThisWorkbook.Worksheets("Calculator").Range("AO5").PasteSpecial xlPasteValues
                OpenBook.Application.CutCopyMode = False
        
                OpenBook.Close False
            End If
    
    Application.Goto Reference:=Worksheets("Calculator").Range("A5"), _
 Scroll:=False
 
Application.ScreenUpdating = True
 
End Sub

I would like to get the filename of the old workbook that was opened and use it in a save-as function to save over top of the old file. I would like to keep the new file open so that I can repeat the process on subsequent files. Of course I will be working on a backup directory of the original files and not the originals themselves.

I have been searching for ways to do this and for code it incorporate but with my minimal knowledge of VBA, I struggle to figure out hoe to incorporate anything and make it all work. I appreciate everyone's help once again.

Answer 1

When you close the OpenBook do:

OpenBook.Close savechanges = True

Answer 2

I would like to get the filename of the old workbook that was opened

You already have that in the code? FileToOpen will have the name of the file which you opened?

If you want to extract just the file name then here is an example.

Option Explicit

Sub Sample()
    Dim FileToOpen
    
    FileToOpen = Application.GetOpenFilename(Title:="Copy Data", _
                                             FileFilter:="Excel Files (*.xls*),*xls*")
    
    If FileToOpen = False Then Exit Sub
    
    MsgBox GetFilenameFromPath(FileToOpen)
End Sub

Public Function GetFilenameFromPath(ByVal FilePath As String) As String
    If Right(FilePath, 1) <> "\" And Len(FilePath) > 0 Then
        GetFilenameFromPath = GetFilenameFromPath(Left(FilePath, Len(FilePath) - 1)) +  _
                              Right(FilePath, 1)
    End If
End Function

Answer 3

The Public Function provided by @Siddarth Rout worked flawlessly once I figured out how to use it. The entire code he provided only displayed a message box with the filename so I had to figure out how to get this into the "Save As" dialogue box. But this was an extra step I did not need in the end.

It took me a while to figure how to make it work but I ended up using SaveCopyAs instead and creating a new folder and incorporating the path into the code. This way I avoided having to accept the filename and find a way to bypass the "File Exists..." box. BTW, I did try "Application.DisplayAlerts = False" to eliminate this but it would not work for me.

However, saving a copy of the file to a new folder using the name derived from the Siddarth's Function worked great.

I also added a "Kill" function to delete the file after the contents were copied. This allowed me to open the first file in the directory without having to select a file (every file needs to be copied)

Here is the final code that works great.

The following code does everything I was looking for and I would also like to thank others here that posted Snippets I was able to use and learn a little from. Sorry but there so many pages I was flipping around through that there is no way to list names. Great community.

Sub CopyDataToNewWB()

    Application.ScreenUpdating = False

    Dim FileToOpen As Variant
    Dim OpenBook As Workbook
    Dim fPath As String

    fPath = "d:\Your\New\Save\Location\"
    FileToOpen = Dir("D:\Dir\Containing\Files\To\Copy\", vbNormal)
    
    
    If FileToOpen <> False Then
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
        OpenBook.Worksheets("Calculator").Range("A5:O199").Copy
        ThisWorkbook.Worksheets("Calculator").Range("A5").PasteSpecial xlPasteValues
        OpenBook.Worksheets("Calculator").Range("AO5:AR34").Copy
        ThisWorkbook.Worksheets("Calculator").Range("AO5").PasteSpecial xlPasteValues
        OpenBook.Application.CutCopyMode = False
        
        OpenBook.Close False
    End If
    
    Kill (GetFilenameFromPath(FileToOpen))
    
    Application.Goto Reference:=Worksheets("Calculator").Range("A5"), _
 Scroll:=True
 
    ActiveWorkbook.SaveCopyAs (fPath & GetFilenameFromPath(FileToOpen))

    Application.ScreenUpdating = True
    
End Sub

Public Function GetFilenameFromPath(ByVal FilePath As String) As String
    If Right(FilePath, 1) <> "\" And Len(FilePath) > 0 Then
        GetFilenameFromPath = GetFilenameFromPath(Left(FilePath, Len(FilePath) - 1)) + _
                              Right(FilePath, 1)
    End If
End Function

With this code attached to a button, it allows me to click and just wait for it to complete and then click again for the next file. Then next step will be to find a way to have the macro repeat X number of times so that I don't have to monitor the process.

With a little modification, I will be able to make almost any retroactive change to a series of Excel files update them with ease. Lovin'VB!