既存のワークシートから新しいワークブックを作成する

Question

ワークブック全体をワークブックからコピーし、カスタマイズしたファイル名で特定のディレクトリに新しいワークブックとして保存する方法（ワークシートのセルのファイル名を選択しようとしています。私はコピーする必要があり、シートの数が少なすぎるマージされたセルを有する

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

を添字を与えるあなたはこのようにそれを試してみてください提案：。

• ジェネレータあなたは.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