Search code examples
excelvbacopyrangesave-as

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


I've been looking on StackOverflow for a solution to this problem and I'm almost there but I can't seem to solve my last problem: saving only a specific worksheet to a new file. Basically, what I want to do is the following:

  1. User clicks and "Archive Data" button
  2. User is prompted to choose a filepath and "SaveAs" a new Excel workbook
  3. Code will copy the range of data in the current worksheet
  4. Code will paste that range to the new Excel workbook specified in the "SaveAs"

My problem is that it saves the whole workbook and I have no way of copying and pasting/saving the specific range in the desired worksheet. Please see the code for reference and let me know if you have any questions.

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

Solution

  • You would use something like this to copy the sheet to a new workbook, which becomes active, then save it using the path specified by the user:

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

    If you don't want the whole sheet, you can use:

    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