”特定のシートだけを別名ファイルで名前をつけて保存する”という汎用性のあるコードを書いてみたぜ ー エクセルマクロ（VBA）

       

VBAをプログラムを書いている時、コードの記述をネットでよく探しています。

それだけ、ブログなどで解説してくれる人も多いので、便利な上に重宝します。

ただ、サンプルのコードは、条件を簡単にしたものなのであくまでも参考です。

自分の希望した通りのコードに仕上げるには、それからは自分の力量次第かな。

こうして、ネットで見つけて参考になるコードは、メモ帳に書いて保存します。

そして、忘備録で特定のフォルダーに保存して、必要に応じて参照するのです。

ただ、参考するコードが、条件設定の上で動作するサンプルでは役立ちません。

そんな時は、条件設定をしなくても、一発で動かしてしまうコードに書き直す。

普遍的なコードにしますが、今回は”シートを別ブックとして保存する”ケース。

初めに、VBAのサイトで有名な”Office TANAKA”さんの投稿を参照にしました。

このやり方ですと、コードにシート名や保存先パスなどの実情報を記述するの。

これを書き換えて実行するぐらいなら、シートの少ない場合、力仕事の方が楽。

不要なシートは削除して、ファイル名を別名にして保存する方が短時間で終了。

ですが、ブックを保存する時、誤って上書き保存したら大変なことになります。

もし、シートが沢山あって、その中の一つを保存するのなら時間が掛かります。

なので、VBエディターにコードを書込んで、ブック内の簡単な操作で終了する。

という分けで、毎回、記述を書き直す箇所の不要なコードを、書いてみました。

下記の通り、コードを紹介しますが、それでもコードを走らせる前の約束事が多少ありますので、その前提条件も紹介しつつ、是非、使って見てもらいたいと思うのでした。

＜サンプルコード＞

Sub Sample1()　'①

Dim ws As Worksheet, ShtNme As String, PthBkNme As String

  ShtNme = Sheets(ActiveSheet.Index).Name '②

    Workbooks.Add '③

      ThisWorkbook.Sheets(ShtNme).Copy After:=ActiveWorkbook.Sheets(Sheets.Count) '④

Application.DisplayAlerts = False

  For Each ws In Sheets '⑤

    If ws.Name <> ShtNme Then ws.Delete

  Next ws

    Application.DisplayAlerts = True

        PthBkNme = "" '⑥

          PthBkNme = PthBkNme & Environ("HOMEPATH")

            PthBkNme = PthBkNme & "\DESKTOP\"

          PthBkNme = PthBkNme & ShtNme

        PthBkNme = PthBkNme & ".xlsx"

     ActiveWorkbook.SaveAs PthBkNme '⑦

   ActiveWorkbook.Close

End Sub

＜使用条件・コード記述のアルゴリズム解説＞

 ① 保存したいシートを開いて、アクティブにしておく

 ② コード実行：保存するアクティブシートのシート名取得

 ③ アクティブシートをコピーするブックを新規に開く（アクティブなブック）

 ④ 保存したいシートのあるブックから全シートをアクティブなブックへコピー

 ⑤ コピー後、アクティブなブックでコピーしたいシート以外は削除する

 ⑥ 保存先（パス）、ファイル名を変数化しておく

 ⑦ デスクトップ上にシート名でファイル保存

いいねと思ったら、三つポチっとね！
  
にほんブログ村    にほんブログ村      にほんブログ村