Создать новую книгу из существующего листа

Как скопировать весь рабочий лист из рабочей книги и сохранить его как новую книгу в конкретный каталог с настроенным именем файла (я пытаюсь выбрать имя файла из ячеек на листе. Лист, который мне нужно скопировать, несколько слит клеток тоже.

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) 

Предложите вам попробовать:

  • Проверьте, существует ли генератор до прогрессирования
  • Если вы используете .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 
Давайте будем гением компьютера.