VBA シートをブックから切り出し名付け保存する

エクセルVBA、シートをブックから抜き出して名前を付けて保存する方法を説明します。
名付けにはSaveAs、シートの取り出しにはMoveメソッドを使っていきます。

こんにちは、じゅんぱ店長（@junpa33）です。

今回の名付けVBAコードは、少々面倒な作業を簡単に熟せるようにするというものです。

ブック内には色々なシートがあります。

時々の業務で「このシートだけ外して別ブックにしたい！」という願望の元、コピペ作業に励むことがあるでしょう。

いわばエクセルブックを資料バインダーと見立てるようなやり方。

コピペ作業は、簡単です、でも少々（コード設計的に）面倒くさくもあります。

このの解説記事では、サクッとMoveメソッドを使って、パッパッと作業を済ませてしまいます。

コンテンツ

シートをブックから取り出し別ブックとして使う　例題提示

どういう時に使うのかイメージが湧かない方もいると思いますので、例題を使います。

ファイル「Book1.xlsm」に2018年3月1日(金)、3月2日(土)、3月5日(月)の書籍発売の資料が各シート毎にあります。

この資料の内2018年3月2日（土）の資料データだけ今回は必要です。

提出のため別ファイル（エクセルブック）として切り離して使いたいです。

この記事で紹介するVBAコードを使えば、マクロ一発このようになります。

目的のシートだけが取り出され、そのシート名でファイル化（独立したブック）しています。

目次へ戻る

切り出したシートを別ブックにそのシート名で保存するVBA

それでは進行の順番にVBAコードの説明です。

記述している全VBAコード

VBA

Sub シート名でブック保存2()
    Dim ASName, BkName As Variant
        ASName = ActiveSheet.Name
        ActiveSheet.Move
    Const FFa As String = "Excel ブック,*.xlsx,Excel マクロ有効ブック, " & _
            "*.xlsm,"
    Const FFb As String = "Excelバイナリブック,*.xlsb," & _
            "Excel97-2003ブック,*.xls,"
    Const FFc As String = "CSVカンマ区切り,*.csv,すべてのファイル,*.*"
    ChDir "C:\Users\●●●\Documents\●●●\●●●\●●●" & _
            "\VBAブックの名前を付けて保存\シート名で名付ける"
        BkName = Application.GetSaveAsFilename(InitialFileName:=ASName, _
            filefilter:=FFa & FFb & FFc, FilterIndex:=1, _
                Title:="名前の変更保存")
        If BkName = "False" Then
            Exit Sub
        End If
        ActiveWorkbook.SaveAs BkName
End Sub

これだけのコードです。コピペでコードを作ると、ブックを開けたり閉めたりと面倒になりますが、これだけです。

VBAコードの解説

目的のシートを移動させるVBA

元データのあるエクセルブックから、必要なシートを取り出すには、「Moveメソッド」を応用します。

応用と言っても、Moveの特性で、以下の様に記述すると、自動的に新規ブックを作成しそのインデックス番号１のシートにその移動したシートを配置します。（この時デフォルトで、その移動したシートのみ作成されます。）

VBA

Sub 新規BOOKへ移転()
        ActiveSheet.Move
End Sub

このMoveメソッドは「移動させる」ので、移動した後の元のブックはこのようになっています。（移動したシートは無くなっています。）

マクロ実行する時のアドバイス

このマクロを実行する前に、元データをコピーしてコピーのブックに対してマクロ実行することをお勧めします。

移動させたシート名をブック名とするVBA

名前をブック名にするには、先にシート名から名前を抽出しておかないといけません。

で、その名前をブック名として保存するわけですが、注意点として

新規ブックに保存する場合、ブック名の拡張子を省略した場合は、デフォルトの.xlsxが当てられる。
名前を付けて保存の場合はフルネーム（FullName）が必要でパス部分を省略した場合は、カレントディレクトリに保存される。

VBA

Sub シート名でブック保存1()
    Dim ASName As Variant
        ASName = ActiveSheet.Name
        ActiveSheet.Move
        ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & ASName
End Sub

このコードを実行した場合、

まず、 ASName でシート名を取得して

そのシートを新規ブックに分離移動します。

そして、アクティブブック（新規ブックのこと）を、このマクロを実行しているブックと同じフォルダに、ASNameという名前でブックを保存します。

切り出したシートの保存先フォルダをその都度変えたい！

フルパスで、VBAコードに保存先を埋め込んでしまっては、いろいろな使用場面では使いずらい。その都度保存先を選べる様にコードを加工する必要がある。

保存先をその都度選択できるようにするVBA

保存先のフォルダをその都度選べる様にするには、定番の「名前を付けて保存ダイアログ」を表示してフォルダ選択ファイル保存実行を行うVBAコードを組んでいきます。

この「GetSaveAsFilename」は非常に便利なので是非覚えておきましょう。

VBA

Sub シート名でブック保存2()
    Dim ASName, BkName As Variant
        ASName = ActiveSheet.Name
        ActiveSheet.Move
    Const FFa As String = "Excel ブック,*.xlsx,Excel マクロ有効ブック, " & _
            "*.xlsm,"
    Const FFb As String = "Excelバイナリブック,*.xlsb," & _
            "Excel97-2003ブック,*.xls,"
    Const FFc As String = "CSVカンマ区切り,*.csv,すべてのファイル,*.*"
    ChDir "C:\Users\●●●\Documents\●●●\●●●\●●●" & _
            "\VBAブックの名前を付けて保存\セル値で名付ける"
        BkName = Application.GetSaveAsFilename(InitialFileName:=ASName, _
            filefilter:=FFa & FFb & FFc, FilterIndex:=1, _
                Title:="名前の変更保存")
        If BkName = "False" Then
            Exit Sub
        End If
        ActiveWorkbook.SaveAs BkName
End Sub