复制工作表中的范围并粘贴和另存为到新的用户指定文件

Question

我一直在 Whosebug 上寻找这个问题的解决方案，我快找到了，但我似乎无法解决我的最后一个问题：仅将特定工作表保存到新文件。基本上，我想做的是：

用户点击和 "Archive Data" 按钮
提示用户选择文件路径和"SaveAs"一个新的Excel工作簿
代码将复制当前工作表中的数据范围
代码将该范围粘贴到 "SaveAs"

我的问题是它保存了整个工作簿，我无法复制和 pasting/saving 所需工作表中的特定范围。请查看代码以供参考，如果您有任何问题，请告诉我。

Sub ArchiveData()

Dim ThisFile As String
Dim NewFile As String
Dim ActBook As Workbook
Dim NewShtName As String
Dim NewFileType As String
NewShtName = "Archived Data on " & Format(Date, "MM.DD.YYYY")

'Copy
ThisFile = ThisWorkbook.FullName
NewFileType = "Excel 1997-2003 (*.xls), *.xls,Excel 2007-2013 (*.xlsx), .*xlsx,Excel 2007-2013 Macro-Enabled (*.xlsm), .*xlsm)"
NewFile = Application.GetSaveAsFilename(InitialFileName:=NewFileName, FileFilter:=NewFileType)

'Paste
If NewFile = "False" Then
    MsgBox ("File unable to be saved")
    Exit Sub
Else
    ActiveWorkbook.Sheets(2).SaveAs Filename:=NewFile, FileFormat:=51 'Need to save as .xls and/or .xlsx
    ThisWorkbook.Sheets(2).range("A4:S65536").Copy
    ActiveWorkbook.Sheets(1).range("A4:S65536").PasteSpecial (xlPasteValues)
    ActiveWorkbook.Sheets(1).Name = NewShtName

    'Close new book
    Set ActBook = ActiveWorkbook
    Workbooks.Open ThisFile
    ActBook.Close

End If
MsgBox ("File saved")
End Sub

Answer 1

您可以使用类似的方法将 sheet 复制到一个新工作簿，该工作簿变为活动状态，然后使用用户指定的路径保存它：

ActiveWorkbook.Sheets(2).Copy
Activeworkbook.SaveAs Filename:=NewFile, FileFormat:=51

如果你不想要整个sheet，你可以使用：

Dim wb as Workbook
Set wb = Workbooks.Add(xlwbatworksheet)
ThisWorkbook.Sheets(2).range("A4:S65536").Copy
    wb.Sheets(1).range("A4").PasteSpecial xlPasteValues
wb.saveas Filename:=NewFile, FileFormat:=51

复制工作表中的范围并粘贴和另存为到新的用户指定文件

Copy range in worksheet and paste and SaveAs to new user-specified file

excel

vba

copy

range

save-as