すぐに役立つエクセルVBAマクロ集 FAQ 同じ文字を含むシートを新規ブックにコピー

　すぐマク　YNxv9987

名前に同じ文字を含むシートを新規ブックにコピーするには？

Ｑuestion 72.8　コピー

Excel VBA Borad （掲示板）より

VBA初心者です。複数シートのコピーについて教えてください。
複数のシートを別ファイルにコピーするマクロを作成しようとして、悪戦苦闘しています。
元のファイルは原価1、原価2・・・、定価1、定価2・・・というシート名のついた複数のシートからなり、シート数は都度異なります。
このファイルの中の定価1、定価2・・・の部分だけをコピーして新規ファイルを作成したいのですが、うまくいきません。
どのようにしたら、できるのでしょうか。
　　※お断り　原文では各シート名に丸文字番号が使われていましたが、ブラウザに配慮し通常の数字に変えました

Ａnswer　　

2005.4.17　Yoshioh Nagai

いろいろな方法が考えられますが、以下のサンプルで実現できると思います。

Sub 名前に同じ文字を含むシートを新規ブックにコピーする()
10  コピー元ブック名 = ThisWorkbook.Name
11  新規作成ブック名 = "定価.xls"
'
30  Set NewBook = Workbooks.Add
31  NewBook.SaveAs Filename:=新規作成ブック名
32  シート名 = ActiveSheet.Name
'
50  Workbooks(コピー元ブック名).Activate
60  For Each 各シート In Workbooks(コピー元ブック名).Sheets
61     If Left(各シート.Name, 2) = "定価" Then
62       Worksheets(各シート.Name).Copy after:=Workbooks(新規作成ブック名).Sheets(シート名)
63       シート名 = 各シート.Name
64       Workbooks(コピー元ブック名).Activate
65     End If
66  Next
70  Workbooks(新規作成ブック名).Activate
End Sub

このテーマは簡単そうに思えますがマクロを組むには、意外とさまざまなテクニックが必要になります。初心者さんということですので、少し解説しておきます。

10行目　コピー元ブックの名前を取得する
11行目　新規作成するブック名を指定する (ユーザーに入力してもらうならこちら)
30～31行目　ブックを新規作成して指定された名前で保存する
32行目　作成したブックのアクティブになっているシート名を取得する
50行目　コピー元ブックをアクティブにする

60～66行目　コピー元ブックの各シートに対して繰り返す
61行目　もし、各シートの名前の左の2文字が '定価' の場合は
62行目　作成したブックの変数「シート名」で指定するシートの後に、各シートをコピーする
63行目　変数「シート名」に、コピーしたシート名を取得する
64行目　コピー元ブックをアクティブにする
70行目　作成したブックをアクティブにする

なお、マクロをコピー元ブックとは異なるブックに作成する場合は、10行目のコードをコピー元ブック名 = "Book1.xls" のように変更すれば可能になります。

http://www.geocities.jp/happy_ngi/