Excel VBA 特定の文字を含むシートを移動

質問

VBA初心者です。

2つのブック(ブック1、ブック2)があり、ブック2でシート名に”●●支店”という文字を含むシートをすべてブック1にコピーしたいです。

支店名はいろいろあるのでinputboxで検索したいです。

VBAを最近実践し始めたところなので、いろいろ調べたものの全く応用がききません。
どなたか教えて頂ける方、よろしくお願いいたします。

回答No.2

imogasi

もう処理期限がすんだのだろうが、やってみたので参考に。
シート名は、同じものはエラーになって許されないことを念頭に下記をいた。
ーー
このコードの記述は、「シートの移動元のブック」の標準モジュールに
Sub test01()
MsgBox ThisWorkbook.Sheets.Count
Workbooks.Open "ＸＸＸ.xlsx" ’移動先のブック
Set wb2 = Workbooks("ＸＸＸ.xlsx") '移動先のブックを変数に格納
sn = InputBox("移すシート名")
MsgBox sn
For Each s In ThisWorkbook.Worksheets 'VBAコードを入れているブックのシートの各々について
MsgBox s.Name & "-" & sn

If s.Name = sn Then '入力シート名と同じか
MsgBox "見つかった"
'--見つかった時の処理
'--移動先ブックで同名のシートはないかチェック
For Each sh2 In Worksheets
If sh2.Name = sn Then
MsgBox "同じ名前のシートがあります"
Exit Sub '処理中止
End If
Next
MsgBox "同じ名前のシートはありません"
s.Move after:=wb2.Sheets(wb2.Sheets.Count) '主目的のシートの移動実行
wb2.Close
Exit Sub
End If
Next
MsgBox "見つかりません"
End Sub
実行がうまく行ったらＭｓｇｂｏｘの行は削除のこと。一歩ずつ確認用です。
ｘｘｘブックに移動するシート名と同じシートは移動先ブックに置かないこと。
テストのつど元の状態（移動したシートは削除しておくこと。）
テストで移動したシートは元のブックに戻してテストすること。
移動先でどこにシートを位置づけるのか指定はないが、勉強のこと。
＞VBAを最近実践し始めたところなので
こんな課題に手を付けるのは早すぎると思う。
コピペしてできても、これだけだと、身に付かない。
質問する前にマクロの記録を調べるとかＷＥＢの関連記事を調べるとか、
質問を自分の困難点にまで絞れるようになること。
なぜ自力でできないのにＶＢＡでやるのか。手動の操作がちゃんと存在するのに。

回答No.1

SI299792

ワイルドカードが使えます。
“●●支店”を検索したい場合、“*支店”と入力してください。
マクロは、Book1 に入れて、そこで実行してください。
'
Option Explicit
'
Sub Macro1()
'　 ブック２でシート名に文字を含むシートをブック１にコピーする
　　Dim Search As String
　　Dim Book2Sheet As Worksheet
　　Dim Count As Integer
'　 キーワード入力
　　Search = InputBox("検索文字")
　　If Search = "" Then
　　　　End
　　End If
'　 シートの削除
　　Application.DisplayAlerts = False
　　Do While Sheets.Count > 1
　　　　Sheets(2).Delete
　　Loop
　　Application.DisplayAlerts = True
'　 コピー
　　For Each Book2Sheet In Workbooks("Book2.xlsx").Worksheets
'　　　 キーワードが見つかれば実行
　　　　If Book2Sheet.Name Like Search Then
　　　　　　Count = Count + 1
'　　　　　 シート２以降追加
　　　　　　If Count > 1 Then
　　　　　　　　Sheets.Add After:=Sheets(Sheets.Count)
　　　　　　End If
　　　　　　Book2Sheet.Cells.Copy Sheets(Count).[A1]
　　　　　　Sheets(Count).Name = Book2Sheet.Name
　　　　End If
　　Next Book2Sheet
End Sub

お礼

SI299792 さん、ご回答ありがとうございました。
どうしても今日の朝必要だったので自分なりに簡易的に書いてみました↓

Sub シート検索から移動()

Dim sh As Worksheet
Dim text As String

Workbooks.Open Filename:= _
"C:～Book2.xlsx"

text = InputBox(Prompt:="シート検索文字列")

For Each sh In Worksheets
If sh.Name Like "*"& text & "*" Then
Application.DisplayAlerts = False
sh.Copy Before:=Workbooks("Book1.xlsm").Sheets(3)

Application.DisplayAlerts = True
End If
Next sh

End Sub

なんとかこれで進みました。
初心者なもので、回答していただいたコードは全部は理解できませんでした。。
もっと勉強しようと思います。お時間割いていただいてありがとうございました。