【Excel VBA】新規ブックにシートをコピーしてフォルダに保存する

Excel VBA講座 開講中!

今回はExcel VBAを使い、新規ブックにシートをコピーしてフォルダに保存する方法についてご紹介します。

新規ブックにシートをコピーしてフォルダに保存する

まず最初に、下記のように「テスト」という名前のシートがあるブックを用意します。

「テスト」シートを用意

「テスト」シートを用意

次に、「テスト」というシートがあるブックに下記のサンプル1のようなプログラムを作成します。

・サンプル1

Sub シート保存()

Dim sh As Worksheet
Dim ws As Worksheet
Dim wb As Workbook
Dim flag As Boolean
Dim fld As String

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

それでは上記サンプル1についてですが、

まず、

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

でファイル保存時などの確認が表示されるようにしています。

シェアする

  • このエントリーをはてなブックマークに追加

フォローする