Copying selected Excel File using macro to the different location along with its content

Question

I am working on macro and I want to write a VBA code to select a file from a particular directory and create a Exact copy of that file with the new name to a particular location.

This is my code to browse and select a file and I want to create a Excel file with same content (including sheets and data present inside those sheets) to a new directory.

Sub BrowseForJ3File()
    j3ExcelSheet = Application.GetOpenFilename(FileFilter:="Excel Workbooks (*.xls*),*.xls*", Title:="Open Excel File")
    If fileToOpen <> False Then
        MsgBox "Open " & fileToOpen
    End If
    ActiveSheet.Range("H9") = j3ExcelSheet
 End Sub

I want to create exact copy of j3ExcelSheet but with a new name and with the same contents present in j3ExcelSheet to a particular location.

Possible duplicate of [VBA to copy a file from one directory to another](https://stackoverflow.com/questions/16943003/vba-to-copy-a-file-from-one-directory-to-another) — FunThomas, Jan 24 '18 at 09:50
You are selecting the file in variable `j3ExcelSheet` and checking the selection in `fileToOpen` — , Jan 24 '18 at 10:06

score 2 · Answer 1 · answered Jan 24 '18 at 09:49

2

Use FileCopy

FileCopy j3ExcelSheet, "C:\Users\IamWhoIam\GloriousSubfolder\Test.xls"

answered Jan 24 '18 at 09:49

FunThomas

23,043
3
18
34

Xabier · Answer 2 · 2018-01-24T10:10:52.033

How about something like below, this will open the file and Save As whatever filename you want, the other answers will copy the files, the difference with this option, is that you can also manipulate the data in the workbook (if you want to before saving it):

Sub BrowseForJ3File()
Dim x As Workbook
    j3ExcelSheet = Application.GetOpenFilename(FileFilter:="Excel Workbooks (*.xls*),*.xls*", Title:="Open Excel File")

    ActiveSheet.Range("H9") = j3ExcelSheet

    Pos = InStrRev(j3ExcelSheet, "\")
    Filename = Mid(j3ExcelSheet, Pos + 1)
    'above get the filename

    Pos = InStrRev(Filename, ".")
    Extension = Mid(Filename, Pos + 1)
    'above get the extension

    Savepath = "C:\Users\Me\Desktop\"
    'get the path to save the new file

    NewFilename = "New Report"
    'above new filename

    Application.DisplayAlerts = False

    Set x = Workbooks.Open(j3ExcelSheet)
    With x
        .SaveAs Savepath & Format(Date, "yyyymm") & " " & NewFilename & "." & Extension
        .Close
    End With
    Application.DisplayAlerts = True
 End Sub

Copying selected Excel File using macro to the different location along with its content

2 Answers2