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

Question 72.8 Excel VBA Borad (掲示板)より Previous Next
VBA初心者です。複数シートのコピーについて教えてください。
複数のシートを別ファイルにコピーするマクロを作成しようとして、悪戦苦闘しています。
元のファイルは原価1、原価2・・・、定価1、定価2・・・というシート名のついた複数のシートからなり、シート数は都度異なります。
このファイルの中の定価1、定価2・・・の部分だけをコピーして新規ファイルを作成したいのですが、うまくいきません。
どのようにしたら、できるのでしょうか。
※お断り 原文では各シート名に丸文字番号が使われていましたが、ブラウザに配慮し通常の数字に変えました。
Answer   2005.4.17 永井善王
いろいろな方法が考えられますが、以下のサンプルで実現できると思います。
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" のように変更すれば可能になります。

 

Excel VBA Macro