回答受付が終了しました

kei********

2022/5/16 10:47

11回答

vba初心者です。過去のQ&Aを拝見し近いものはあったのですが、無知な自分にどうかご教授下さい。 ＜内容＞

vba初心者です。過去のQ&Aを拝見し近いものはあったのですが、無知な自分にどうかご教授下さい。 ＜内容＞ ﾌｫﾙﾀﾞを指定。複数Excelﾌｧｲﾙが存在しますが、このexcel内のｼｰﾄ名を検索してhitすればﾌｧｲﾙを一つ下の階層ﾌｫﾙﾀﾞに移動させたいのです。 （例） 重複してしまいますが・・・。 ﾌｫﾙﾀﾞを指定して、このﾌｫﾙﾀﾞ内にある複数のexcel（最大1500ﾌｧｲﾙ）の中から、ｼｰﾄ名に「赤」が付いたexcelﾌｧｲﾙを抽出し（excelﾌｧｲﾙには「赤」が付いていないﾌｧｲﾙも存在します）、このﾌｫﾙﾀﾞの一つ下のﾌｫﾙﾀﾞに移動させたいのです。 ・できればﾌｫﾙﾀﾞの指定に（msoFileDialogFolderPicker） ・ｼｰﾄ名の検索にInputBoxで検索文字列を入力する形で出来ると... かなり、欲しがってしまい申し訳ございません。 大掛かりとなってしまいそうですが、どうか、どうかお力をお貸しください。 宜しくお願い致します。

Visual Basic・101閲覧

回答（1件）

0
osh********

2022/5/16 16:01

エラー処理などは実装していませんので、必要に応じて加筆してみてください。 Sub test() strIn = InputBox("検索するシート名称") ChDir (ThisWorkbook.Path) '当該フォルダのブック数分LOOP buf = Dir("*.xlsx") Do While buf <> "" hit = 0 Workbooks.Open Filename:=buf With Workbooks(buf) '開いたブックのシート数分LOOP For ii = 1 To .Worksheets.Count '指定されたシート名が存在するか If InStr(.Worksheets(ii).Name, strIn) > 0 Then hit = 1 Exit For End If Next ii Workbooks(buf).Close '指定されたシートが存在したら If hit = 1 Then 'フォルダ選択ダイアログ With Application.FileDialog(msoFileDialogFolderPicker) .InitialFileName = ThisWorkbook.Path .Title = "フォルダの選択" If .Show = True Then 'ブックを移動する Name ThisWorkbook.Path & "\" & buf As .SelectedItems(1) & "\" & buf End If End With End If End With buf = Dir() Loop End Sub