Excel 雛形シートを複製して新規ワークブックを保存するマクロ

雛形シートを複製して新規ワークブックを保存するマクロです。

「雛型1」という名前のシートを用意しておき、そのシートをコピーして別ファイル名で保存します。

'雛形シートを複製して新規ワークブックを保存するマクロ

'変数宣言の強制
Option Explicit

'固定値 雛形シート名
Const TemplateSheet1 As String = "雛型1"
'固定値 出力ファイル名
Const outputFilename As String = "ABCファイル"

'実行ボタン
Private Sub BtnExec_Click()

    '確認メッセージ
    Dim res
    res = MsgBox("処理を開始します。" & vbNewLine & "よろしいですか？", vbYesNo + vbDefaultButton2 + vbQuestion, "確認")
    If res = vbNo Then Exit Sub
        
    'デスクトップのパス取得
    Dim path As String
    Dim WSH As Object
    Set WSH = CreateObject("WScript.Shell")
    path = WSH.SpecialFolders("Desktop") & "\"
        
    '新規ワークブックを追加
    Dim targetBook As Workbook
    Set targetBook = Workbooks.Add
    
    '雛形シートを特定
    Dim sourceSheet As Worksheet
    Set sourceSheet = ThisWorkbook.Worksheets(TemplateSheet1)
    
    '新規ワークブックへ雛形シートを複製
    sourceSheet.Copy After:=targetBook.Sheets(targetBook.Sheets.Count)
    
    Dim targetSheet As Worksheet
    Set targetSheet = targetBook.Sheets(sourceSheet.Name)
    targetSheet.Visible = xlSheetVisible
        
    '==================================================
    'ここにtargetSheetに対しての作成処理を追加する
    '==================================================
        
    '不要シート削除
    Application.DisplayAlerts = False
    targetBook.Worksheets("Sheet1").Delete
    Application.DisplayAlerts = True
    
    '先頭シートの選択
    targetBook.Worksheets(1).Select

    '名前を付けて保存
    Dim newFileName As String
    newFileName = outputFilename & "_" & Format(Now, "yyyymmddhhnnss") & ".xlsx"
    targetBook.SaveAs path & newFileName
    
    '閉じる
    targetBook.Close
    
    '完了メッセージ
    Call MsgBox("ファイルを出力しました。" & vbNewLine & "ファイル名：" & newFileName, vbOKOnly + vbInformation, "情報")
    
End Sub