📋

CopySheetToNewWorkbook

シート管理

指定したシートを新しいブックにコピーする

特定のワークシートを新しいブックとして切り出すVBAマクロです。Worksheet.CopyメソッドにAfter引数を指定しないことで新規ワークブックが自動生成され、そのシートだけを含むファイルとして保存できます。大きなマスタファイルから特定データを抽出して関係者に配布する際などに役立ちます。保存先パスや形式の指定、元データのリンク切り離しも合わせて実装できます。内部では引数なしのCopyメソッドを呼び出すことで新規ブックが自動生成される仕組みを利用しており、CopySheetが同一ブック内の複製であるのに対し、本マクロは完全に独立したファイルとして切り出す点が異なります。切り出し後にPasteSpecialで値のみに変換すれば、元データへの参照が残らない安全な配布用ファイルになります。手動での「シートの移動またはコピー」ダイアログ操作より確実に同じ結果を再現できます。

📖 使い方

VBAエディタを開く（Alt + F11）
モジュールを挿入（挿入 > モジュール）
下記VBAコードをコピー&ペースト
ブック上で実行（Alt + F8 でマクロ選択）

💡 実行例：実行するとコピー元のシート名を入力し、新しいブックが作成される

🎯 活用シーン

✓月次レポートから特定部署のシートだけを抜き出して送付
✓大規模なデータブックから取引先ごとにシートを分離してPDF化
✓機密データを除外して外部共有用の軽量ファイルを生成
✓社外パートナーに共有するデータだけを抜き出し、独立したファイルとして受け渡したいとき
✓個人情報を含む列を除いたシートだけを切り出して、閲覧権限の異なる相手に配布したいとき

💡 実装のヒント

▸引数なしのCopyで新規ブックにコピーされます
▸コピー後にSaveAsで名前を付けて保存します
▸値のみにするにはPasteSpecial xlPasteValuesを使います
▸複数シートをまとめて1つの新規ブックに切り出したい場合は、Arrayでシート名を指定してからCopyを実行してください。
▸切り出したファイルに機密情報が含まれていないか、配布前に必ず目視確認する運用ルールを設けることをお勧めします。

💻 VBAコード

' CopySheetToNewWorkbook
' -----------------
' Macro Name: CopySheetToNewWorkbook
' Description: 指定したシートを新しいブックにコピーする
' Parameters: なし
' Returns: なし
' Usage: 実行するとコピー元のシート名を入力し、新しいブックが作成される
' -----------------

Sub CopySheetToNewWorkbook()
    Dim ws As Worksheet
    Dim newWb As Workbook
    Dim sheetName As String
    Dim savePath As String
    Dim fileFormat As XlFileFormat
    Dim saveErrNumber As Long
    Dim saveErrDescription As String

    On Error GoTo ErrorHandler

    sheetName = InputBox("新しいブックにコピーするシート名を入力:", "シートコピー", ActiveSheet.Name)

    If sheetName = "" Then
        Exit Sub
    End If

    On Error Resume Next
    Set ws = Worksheets(sheetName)
    On Error GoTo ErrorHandler

    If ws Is Nothing Then
        MsgBox "「" & sheetName & "」は存在しません。", vbExclamation
        Exit Sub
    End If

    ws.Copy

    Set newWb = ActiveWorkbook

    savePath = InputBox("保存先のパスを入力:" & vbCrLf & "(空欄の場合はキャンセル)", "保存先指定", Environ("USERPROFILE") & "\Desktop\" & sheetName & ".xlsx")

    If savePath = "" Then
        newWb.Close SaveChanges:=False
        MsgBox "キャンセルされました。", vbInformation
        Exit Sub
    End If

    If InStrRev(savePath, ".") <= InStrRev(savePath, "\") Then
        savePath = savePath & ".xlsx"
    End If

    fileFormat = xlOpenXMLWorkbook

    On Error Resume Next
    newWb.SaveAs Filename:=savePath, FileFormat:=fileFormat
    saveErrNumber = Err.Number
    saveErrDescription = Err.Description
    On Error GoTo ErrorHandler

    If saveErrNumber <> 0 Then
        newWb.Close SaveChanges:=False
        MsgBox "ファイルの保存に失敗しました: " & saveErrDescription, vbCritical
        Exit Sub
    End If

    MsgBox "「" & sheetName & "」を新しいブックにコピーしました。" & vbCrLf & savePath, vbInformation
    Exit Sub

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

🔗 同カテゴリの関連マクロ