シートを分離して他ブックに移動して保存する方法

質問

標題の通り
あるブックにあるシートを検索してシート名に○○○が含まれているという条件で
該当したシートを他ブックに移動する方法を探しています。
マクロ、ＶＢ等で実施できる？

分かり難いので例を示します。

設計書.xls
シート「設計書１」
シート「設計書２」
シート「テスト１」
シート「設計書３」
シート「テスト２」

にあったとして、今回作成するバッチを起動すると
シートに「テスト」が含まれいるものを
他のブックを新規作成して、ファイル名を
設計書テスト.xls
として登録する。

つまり、
設計書.xls
シート「設計書１」
シート「設計書２」
シート「設計書３」

設計書テスト.xls
シート「テスト１」
シート「テスト２」

とふたつのブックができあがることとなる。

以上、助言をお願い致します。

回答No.2

keithin · ベストアンサー

やり口は色々考えられますが例えば。

sub macro1()
　dim bk0 as workbook
　dim bk1 as workbook
　dim w as worksheet

’最初に作業対象のブックを取得すること
　set bk0 = activeworkbook　'もしくは　=workbooks("設計書.xls")

　for each w in bk0.worksheets
　　if w.name like "テスト*" then
　　’該当のシートを移動すること
　　　on error goto errhandle
　　　w.move after:=bk1.worksheets(bk1.worksheets.count)
　　　on error goto 0
　　end if
　next

’保存する
　bk0.save
　if not bk1 is nothing then bk1.saveas "設計書テスト.xls"
　exit sub

’一枚目の該当シートで移動先ブックを作ること
errhandle:
　w.move
　set bk1 = activeworkbook
　resume next
end sub

といったカンジで。

回答No.3

imogasi

出来るか？
出来る。VBAの経験あるのか。
（１）質問の内容がはっきりしないが
複数ブックの中から○○○○が含まれるシートを１つのブックにまとめるのか。
それなら在るフォルダのすべてのエクセルファイル名をとらえ、そのブック内のそのシート名を見て○○○○が含まれるシートは何か１つのブックに集める。（１シートを別ブックにするのか質問ではっきりしない。
しっかり説明のこと。
Google[ででも「VBA フォルダ　ファイル　取得」で照会して勉強すること。
（２）１つのブック内のシート名を見て○○○○が含まれるシートは何か１つのブックに集めるとすると
この場合は
Sub test01()
For Each sh In Worksheets
p = InStr(sh.Name, "Sh")
If p <> 0 Then
MsgBox sh.Name
End If
Next
End Sub
のようなのをやってみれば、やり方が判るだろう。テストではSheet1-Sheet5などの中に名前を変えたシートを作って実験してみて。

お礼

imogasiさん　助言ありがとうございます。

質問は、（１）を想定して記述しました。
（２）のことは考えていませんでした・・・。

回答No.1

mt2008

VBAでやるならこんな感じで。
設計書.xlsにこのコードを入れて見てください。
サンプルなのでエラー処理一切していません。あしからず。

Sub Sample()
　　　Dim ws As Worksheet
　　　Dim sName() As String
　　　Dim i
　　　'*****シート名に「テスト」を含む物を探す
　　　i = 0
　　　For Each ws In Worksheets
　　　　　　If InStr(ws.Name, "テスト") > 0 Then
　　　　　　　　　ReDim Preserve sName(i)
　　　　　　　　　sName(i) = ws.Name
　　　　　　　　　i = i + 1
　　　　　　End If
　　　Next ws
　　　'*****探し出したシートをMOVE
　　　If i > 0 Then
　　　　　　Sheets(sName()).Move
　　　　　　ActiveWorkbook.SaveAs Filename:="C:\設計書テスト.xls"
　　　End If
End Sub