このサイトの記事内では「アフィリエイト広告」などの広告を掲載している場合があります。
消費者庁が問題としている「誇大な宣伝や表現」とならないよう配慮しコンテンツを制作しておりますのでご安心ください。
問題のある表現が見つかりましたらお問い合わせよりご一報いただけますと幸いです。

【VBA】シートを新規ブックとして保存する方法

Excelで作業していると、あるシートだけ別ブックにして他の人に渡したいことが多々あります。

ただこの作業、新規ブックを立上げて、シートをコピー、デフォルトのシートを削除、と意外と手間がかかってきます。

こうした作業を排除すべく、今回はアクティブシートを新規ブックとして保存するプログラムを紹介します。

コピペで使えるようにしたので、サクッと導入してみてください。

VBAが難しいと感じたら
VBAのプロに代わりに作ってもらうのはいかがでしょうか?
ココナラでVBAの作成請負を受け付けています。お気軽にご相談ください。

【VBA】シートを新規ブックとして保存する方法

Sub CopyToNewBook()
    '''アクティブシートを新規ブックへコピーして保存
    '''デフォルトのシートは削除する
    
    Dim actSht As Worksheet
    Set actSht = ActiveSheet
    
    ''ファイル名を取得
    Dim strFileName As String
    strFileName = InputBox("新規作成するExcelファイル名を入力してください")
    If StrPtr(strFileName) = 0 Then: Exit Sub
    
    ''保存フォルダパスを取得
    Dim strFldrPath As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = 0 Then: Exit Sub 'キャンセルされたときの処理
        strFldrPath = .SelectedItems(1)
    End With
    
    Dim sht_i As Long
    With Workbooks.Add
        actSht.Copy after:=.Sheets(.Sheets.Count) 'シート末尾に追加
        
        ''コピーシート以外を削除
        For sht_i = .Sheets.Count To 1 Step -1
            If sht_i <> .Sheets.Count Then .Sheets(sht_i).Delete
        Next
        
        .Sheets(.Sheets.Count).Name = actSht.Name 'sheet1(1)の場合を想定
        .SaveAs strFldrPath & "\" & strFileName & ".xlsx" 'ファイル保存
    End With
End Sub

このマクロを使うとアクティブシートをコピーして新規ブックとして保存することができます。

実行すると、最初にファイル名と保存フォルダを聞かれるので保存したい名前とフォルダを選択します。

選択が終わると新規ブックにアクティブシートがコピーされて自動保存されます。

保存フォルダの取得(Application.FileDialog)については下記記事をご覧ください。

なお、ブックを作成したときのデフォルトシート(Sheet1など)を削除するコードも入れています。

「このシートは完全に削除されます。続けますか?」とダイアログが出ますが、すべて「削除」を押してください。

VBAが難しいと感じたら
VBAのプロに代わりに作ってもらうのはいかがでしょうか?
ココナラでVBAの作成請負を受け付けています。お気軽にご相談ください。

VBA

Posted by やろまい