Reputation: 65
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.
Upvotes: 0
Views: 3037
Reputation: 65
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!
Upvotes: 0
Reputation: 149297
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
Upvotes: 1
Reputation: 76
When you close the OpenBook do:
OpenBook.Close savechanges = True
Upvotes: 1