[[20200206165234]]　『ブック内の値をシート名を含む他のブックを指定フ』（我論）　ページの最後に飛ぶ

『ブック内の値をシート名を含む他のブックを指定フォルダの中から検索して開きたい』（我論）

いつもお世話になっております。
VBA初心者ながら興味深くまた勉強させていただいております。
こちらだけでなく色々なサイトでも検索したのですが
どうにも糸口がつかめずお知恵をお借りしたく書き込ませていただきます。

Aブック内に品番が120ほどあり
A列に日付B列に曜日C列以降に品番があり
日別の数値が入っています。

　 A 　B 　C 　　D　　　E
1 　　　　 1111　1112　1113
2 1日月　 20　　30　　40
3 2日火　 20　　30　　40
4 3日水　 10　　20　　30
5 4日木　 20　　30　　40
6 5日金　 10　　30　　30

Aブックがあるフォルダの下層に各品番を区分けした
フォルダが複数あり、さらに品番30前後に区分けされたブックが
複数あります。
そちらのブックは品番をシート名としていて、
A列に日付 B列に曜日 C列に数値を入れることになります。

例)フォルダ構成
Aフォルダ-Aブック
　　　　 1フォルダ-区分ブック1
　　　　　　　　　　区分ブック2「1111」シート
　　　　　　　　　　区分ブック3
　　　　　2フォルダ-区分ブック1
　　　　　　　　　　区分ブック2
　　　　　3フォルダ-区分ブック1
　　　　　　　　　　区分ブック2
　　　　　　　　　　区分ブック3
　　　　　　　　　　区分ブック4
Aブック内品番「1111」をシート名とするシートを含むブック
を特定し、値を貼り付けしたい

これをAブック内にある品番からシート名を含むブックを
割り出し数値をコピーして貼り付けするという
プログラムを組みたいのですが、
下層フォルダが4つあり、その中にも複数あるブックの中から
品番と合致するシートが含まれているブックを開くという
部分をどのように組立たら良いのかまったく思いつかない状況です。

フォルダ内の繰り返し処理で全ブックを検索するのであれば、
FSOを使えば良いと思うのですが、最終的には120ある品番を
一括で処理することを想定しているため、
先に特定のシートを含むブックを開いてしまえば、
値を貼り付けるのは難しくないのではと考えています。

何か糸口はありませんでしょうか？
よろしくお願いいたします。

＜使用 Excel：Excel2013、使用 OS：Windows10 ＞

以下のマクロを実行すると（cPathは変えてくださいね）、品番（4桁数字のシート名）と、ファイル名の一覧を作成します。品番を含むブックのフルパスが判るので、この情報を元に、貼り付けたいブックを開けば良いかと思いますよ。

 Sub test()
    Const cPATH = "c:\tmp\"
    Dim cFiles As Variant
    Dim cFile As String
    Dim i As Long
    Dim j As Long
    Dim iR As Long

    Application.ScreenUpdating = False
    Range("A1:C1") = Array("品番", "ファイル名", "フルパス")
    iR = 1

    cFiles = Split(CreateObject("WScript.Shell").Exec("CMD /C DIR /A:-D/B/S """ & cPATH & "*.xls*""").StdOut().ReadAll(), vbNewLine)
    For i = 0 To UBound(cFiles) - 1
        If InStr(cFiles(i), "$") = 0 Then
            cFile = Mid(cFiles(i), InStrRev(cFiles(i), "\") + 1)
            With Workbooks.Open(cFiles(i), False, True)
                For j = 1 To .Sheets.Count
                    If Val(.Sheets(j).Name) Like "????" Then
                        iR = iR + 1
                        Cells(iR, "A").Value = .Sheets(j).Name
                        Cells(iR, "B").Value = cFile
                        Cells(iR, "C").Value = cFiles(i)
                    End If
                Next j
                .Close False
            End With
        End If
    Next i
    Application.ScreenUpdating = True
 End Sub
（???） 2020/02/06(木) 18:01

素早いご回答ありがとうございました。
日曜日にはいただいたプログラムを現場で
確認出来ますので実際に動かしてみます。

確かに一旦リストにしてみれば
参照は簡単ですね。
一度試してみようと思います。
（我論） 2020/02/06(木) 21:33

コメント返信：

[ 一覧(最新更新順) ]

[[20200206165234]] 『ブック内の値をシート名を含む他のブックを指定フ』（我論） ページの最後に飛ぶ

[[20200206165234]]　『ブック内の値をシート名を含む他のブックを指定フ』（我論）　ページの最後に飛ぶ