📊 Excel VBA Top100
⚡

CopyToNewWorkbook

自動化

アクティブシートを新しいブックにコピーして保存します

アクティブシートまたは選択した複数のシートを新しいブックにコピーして保存するマクロです。特定のシートだけを切り出して別ファイルとして配布したい場合や、テンプレートから独立したブックを作成する際に使います。コピー後の新ブックのファイル名・保存先はダイアログで指定でき、元のブックは変更されません。月次・週次レポートを独立したファイルとして保管するワークフローの自動化にも使えます。内部ではWorksheet.Copyメソッドを新規ブック指定で呼び出しており、コピー元のシートはそのまま維持されます。MergeWorkbooksが複数ブックを1つに統合する処理であるのに対し、本マクロはその逆に1つのブックから特定シートだけを切り出す処理にあたり、両者は対になる関係として使い分けられます。手動での「シートの移動またはコピー」操作を毎回行う手間を省ける点も実務上のメリットです。

CopyToNewWorkbook デモ

📖 使い方

  1. VBAエディタを開く(Alt + F11)
  2. モジュールを挿入(挿入 > モジュール)
  3. 下記VBAコードをコピー&ペースト
  4. ブック上で実行(Alt + F8 でマクロ選択)
💡 実行例: CopyToNewWorkbook を実行すると、現在のシートが新ブックに複製されます

🎯 活用シーン

  • ✓月次レポートの集計シートだけを独立したブックとして保存し、上司や取引先に配布しやすいファイルを素早く作成したいとき
  • ✓マスターテンプレートから月別・担当者別の個別ファイルを一括生成して、それぞれのファイルを独立して管理したいとき
  • ✓大きなブックの特定シートだけを軽量なファイルとして切り出し、メールで送信しやすいサイズに分割したいとき
  • ✓全社共有の大きなマスターブックから、部門ごとのデータだけを抜き出して個別配布したいとき
  • ✓監査対応で特定期間のデータシートだけを独立ファイルとして提出する必要があるとき

💡 実装のヒント

  • ▸コピーされるのはシートのデータと書式です。他のシートへの参照数式は値としてコピーされるか、参照先が変更になる場合があります。
  • ▸新ブックへのコピー後に自動保存するには、Workbook.SaveAsメソッドを追加します。保存ダイアログを省略したい場合は保存先パスを事前に設定してください。
  • ▸複数シートをコピーする場合は、シート名を配列で指定するか、移動したいシートのタブを選択してから実行してください。
  • ▸他シートを参照する数式を含む場合は、コピー後に値貼り付け(PasteSpecial xlPasteValues)に変換しておくと参照切れを防げます。
  • ▸保存先フォルダやファイル名の命名規則をあらかじめマクロに組み込んでおくと、切り出し作業を完全に自動化できます。

💻 VBAコード

' CopyToNewWorkbook
' -----------------
' Macro Name: CopyToNewWorkbook
' Description: アクティブシートを新しいブックにコピーして保存します
' Parameters: なし
' Returns: なし
' Usage: CopyToNewWorkbook を実行すると、現在のシートが新ブックに複製されます
' -----------------

Sub CopyToNewWorkbook()
    On Error GoTo ErrorHandler

    Dim srcWs As Worksheet
    Dim newWb As Workbook
    Dim savePath As String

    Set srcWs = ActiveSheet
    srcWs.Copy

    Set newWb = ActiveWorkbook
    savePath = srcWs.Parent.Path & "\" & srcWs.Name & "_copy.xlsx"

    newWb.SaveAs Filename:=savePath, FileFormat:=xlOpenXMLWorkbook

    MsgBox "新しいブックに保存しました:" & vbCrLf & savePath, vbInformation, "完了"

    Exit Sub

ErrorHandler:
    MsgBox "エラーが発生しました:" & vbCrLf & Err.Description, vbCritical, "エラー"
End Sub