从现有工作表创建新工作簿

时间:2016-06-21 17:54:17

标签: excel vba

如何从工作簿中复制整个工作表并将其作为新工作簿保存到具有自定义文件名的特定目录(我正在尝试从工作表中的单元格中选择文件名。我需要复制的工作表很少有合并细胞。

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

当我运行它时,在这一行中给我下标超出范围错误

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

1 个答案:

答案 0 :(得分:1)

建议你这样试试:

  • 在进行
  • 之前检查 Generator 是否存在
  • 如果您使用.Copy,则工作表会自动复制到新工作簿(因此您不需要先添加新书)

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