今回はExcel VBAを使い、新規ブックにシートをコピーしてフォルダに保存する方法についてご紹介します。
新規ブックにシートをコピーしてフォルダに保存する
まず最初に、下記のように「テスト」という名前のシートがあるブックを用意します。
「テスト」シートを用意
次に、「テスト」というシートがあるブックに下記のサンプル１のようなプログラムを作成します。
・サンプル１
| Sub シート保存() Dim sh As Worksheet Set wb = Workbooks.add Application.ScreenUpdating = False Application.DisplayAlerts = False For Each ws In ThisWorkbook.Worksheets If ws.Name = “テスト” Then flag = True Next ws If flag = True Then Set sh = ThisWorkbook.Worksheets(“テスト”) sh.Copy After:=ActiveWorkbook.Worksheets(Worksheets.Count) ActiveWorkbook.Worksheets(“Sheet1”).Delete fld = ThisWorkbook.Path & “\” & “テスト” If Dir(fld, vbDirectory) = “” Then MkDir fld End If ActiveWorkbook.Close SaveChanges:=True, Filename:=fld & “\テスト.xlsx” Else MsgBox “シートが見つかりませんでした” End If Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub |
それでは上記サンプル１についてですが、
まず、
Set Wb = Workbooks.add
で新規ブックを作成します。
Application.ScreenUpdating = False
は画面描画の停止で、
Application.DisplayAlerts = False
はファイル保存時などの確認を非表示としています。
For Each ws In ThisWorkbook.Worksheets
If ws.Name = “テスト” Then flag = True
Next ws
は、先ほど「テスト」というシートを作成したブックから「テスト」というシートを検索し、存在して入れば変数flagをTrueとします。
If flag = True Then
は、変数flagがTrueの場合の条件分岐です。
Set sh = ThisWorkbook.Worksheets(“テスト”)
は変数shに「テスト」シートを代入します。
sh.Copy After:=ActiveWorkbook.Worksheets(Worksheets.Count)
ですが、この時点でのアクティブブックは先ほど「Set Wb = Workbooks.add」で作成した新規ブックとなっています。
その新規ブックのシート数をカウントした数の、後ろに「テスト」シートをコピーしています。
ActiveWorkbook.Worksheets(“Sheet1”).Delete
は、新規ブックに始めから存在している「Sheet1」という名前のシートは必要ありませんので、削除しています。
fld = ThisWorkbook.Path & “\” & “テスト”
は変数fldに、「テスト」というシートを作成したブックが存在するパスの、「テスト」というフォルダを代入しています。
If Dir(fld, vbDirectory) = “” Then
MkDir fld
End If
ですが、
変数fldのフォルダが無い場合は作成し、ある場合は何もしないという処理です。
ActiveWorkbook.Close SaveChanges:=True, Filename:=fld & “\テスト.xlsx”
はブックに「テスト」という名前を付けて保存し、保存後にブックを閉じる処理です。
MsgBox “シートが見つかりませんでした”
は、「テスト」というシートが見つからなかった場合、「シートが見つかりませんでした」というメッセージが表示される処理です。
最後に
Application.DisplayAlerts = True
で画面描画を再開し、
Application.ScreenUpdating = True
でファイル保存時などの確認が表示されるようにしています。