1
votes

How to copy the entire worksheet from a workbook and save it as new workbook to a specific directory with the customized filename(I am trying to pick the filename from on of the cells in the worksheet. The sheet that I need to copy has few merged cells too.

Sub CopyItOver()
Dim fname As String
Dim fpath As String
Dim NewBook As Workbook
Dim name as String 

fpath = "C:\Users\..\"
fname = "List" & name & ".xlsm"
name =   Range("c3").Value 

Set NewBook = Workbooks.Add

 ActiveWorkbook.Sheets("Generator").Copy Before:=NewBook.Sheets(1)

    If Dir(fpath & "\" & fname) <> "" Then
    MsgBox "File " & fpath & "\" & fname & " already exists"
      Else
    NewBook.SaveAs FileName:=fpath & "\" & fname
End If

End Sub

When I run this it, give me Subscript out of range error in this line

 ActiveWorkbook.Sheets("Generator").Copy Before:=NewBook.Sheets(1)
1
In this case your challenge is determining what part of that statement is giving you the error. It could be Activeworkbook.Sheets("Generator") or it could be NewBook.Sheets(1). When the program stops, choose to Debug the VBA and in the immediate window type Debug.Print Activeworkbook.Sheets("Generator").Name and Debug.Print NewBook.Sheets(1).Name and see what you get. It's likely that one of those actions will give you the error and show you what's missing. - PeterT

1 Answers

1
votes

Suggest you try it like this:

  • Check to see if Generator exists before progressing
  • If you use .Copy then the worksheet is automatically copied to a new workbook (so you don't need to add a new book first)

code

Sub CopyItOver()
Dim fname As String
Dim fpath As String
Dim name As String
Dim ws As Worksheet

fpath = "C:\Users\..\"
fname = "List" & name & ".xlsm"
name = Range("c3").Value

On Error Resume Next
Set ws = ThisWorkbook.Sheets("Generator")
On Error GoTo 0

If ws Is Nothing Then
   MsgBox "sheet doesn't exist"
   Exit Sub
End If

If Dir(fpath & "\" & fname) = vbNullString Then
  ThisWorkbook.Sheets("Generator").Copy
  ActiveWorkbook.SaveAs Filename:=fpath & "\" & fname
Else
     MsgBox "File " & fpath & "\" & fname & " already exists"
End If

End Sub