从现有的工作表创build新的工作簿

如何从工作簿复制整个工作表，并将其作为新工作簿保存到具有自定义文件名的特定目录（我试图从工作表中的单元格中select文件名。我需要复制的工作表几乎没有合并细胞也。

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) 

Answer 1

build议你尝试这样的：

• 在进行之前检查发生器是否存在
• 如果使用.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