使用宏将选定的 Excel 文件及其内容复制到不同的位置答案

【问题标题】：Copying selected Excel File using macro to the different location along with its content使用宏将选定的 Excel 文件及其内容复制到不同的位置
【发布时间】：2018-01-24 09:43:33
【问题描述】：

我正在处理宏，我想编写一个 VBA 代码来从特定目录中选择一个文件，并使用新名称创建该文件的精确副本到特定位置。

这是我浏览和选择文件的代码，我想创建一个具有相同内容（包括工作表和工作表中的数据）的 Excel 文件到新目录。

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

我想创建 j3ExcelSheet 的精确副本，但使用新名称和 j3ExcelSheet 中存在的相同内容到特定位置。

【问题讨论】：

VBA to copy a file from one directory to another的可能重复
您正在选择变量j3ExcelSheet 中的文件并检查fileToOpen 中的选择

标签： vba excel

【解决方案1】：

使用FileCopy

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

【讨论】：

【解决方案2】：

如下所示，这将打开文件并另存为您想要的任何文件名，其他答案将复制文件，与此选项的区别在于您还可以操作工作簿中的数据（如果您想保存之前）：

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

【讨论】：