次の、ExcelVBAロボットへのお願いは「データをもってきて！」

フォルダの中にファイルがずらっと並び・・・は
#001探すファイルのリンク一覧をつくる
でスピードアップっ！！できましたか？

探したファイルがエクセルだと、
それには複数のシートがあることがあることが多いかと思います。
そうすると、次はシートを選んで、データをコピペしたり、プリントアウトしでしょうか？

自分の経験では、データを取り出して作業する場合、
Ａ：同じパターンエクセルファイルがたくさん有る
　→シートが決まっていることが多い
Ｂ：逆に、探すエクセルに同じパターンのシートががたくさん有る
　→特定のエクセルファイルのことが多い
と考えます。
今回は
検索したファイルの、決まったシートにある、データを取り出す
ExcelVBAロボットを作ります。

取り出すデータは、「贈答品」シートのお歳暮の品物と金額です

１．エクセルシートをこうして。

２．標準モジュールにコードをコピペ

Sub データを取り出し()

    Application.ScreenUpdating = False 'スクリーンOFF

    Sheets("Sheet1").Select  'シートの選択
    
    '一覧表の最終行の取得
    maxRow = Range("C65536").End(xlUp).Row
    
    '前に書き出した一覧表クリア
    maxRow = Range("C65536").End(xlUp).Row
    If maxRow >= 12 Then
        Range(Cells(12, 3), Cells(maxRow, 6)).Select
        Selection.ClearContents
    End If
    Range("C6").Select
    
    '書き出し行
    gyo = 12

    'ターゲットのフォルダ名：ディレクトリ名
    pt = Range("C3")
    
    '検索ワード
    word_s = Range("C6")
    
    
    'data位置
    data1_r = Range("G4")
    data1_c = Range("H4")
    data2_r = Range("G5")
    data2_c = Range("H5")


'    'data位置位置ワード
'    word_i = Range("G7")
'    'data1位置
'    data1_suu = Range("H8")
'    'data2位置
'    data2_suu = Range("H9")
    
        
    'ターゲットファイルの、データのあるシート名
    t_sheet = Range("C9")
    
    'このエクセルファイル名************
    a_name = ActiveWorkbook.Name

    'このシート名　a_sheet*************
    'a_sheet = ActiveSheet.Name
    
    
    'ターゲットファイルを開いてデータを取り出す------------------------------------始まり
    
    fn = Dir(pt & "\*.*") '1個目のファイル名を格納

    Do While fn <> ""
    
        If InStr(fn, word_s) > 0 Then  '検索ワードが含まれる場合に
        
            'ファイル名
            Cells(gyo, 3) = fn   'ファイル名を書き出し
            'ファイル名（フルパス）
            t_fll = pt & "\" & fn
            
            ActiveSheet.Hyperlinks.Add anchor:=Cells(gyo, 6), Address:=pt & "\" & fn 'リンクを書き出し
                       
             'ファイルを開く
            Workbooks.Open Filename:=t_fll
            'ターゲットファイルの、データのあるシートを選択
            Sheets(t_sheet).Select
            
'            '位置ワード 検索実行
'            Cells.Find(What:=word_i, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
'                xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
'                , MatchByte:=False, SearchFormat:=False).Activate
'
'                    data1_r = ActiveCell.Row
'                    data1_c = ActiveCell.Column + data1_suu
'                    data2_r = ActiveCell.Row
'                    data2_c = ActiveCell.Column + data2_suu
'
            
            data1_v = Cells(data1_r, data1_c)
            data2_v = Cells(data2_r, data2_c)
            
            'ターゲットファイルを閉じる()
            For Each wb In Workbooks
              If wb.Name = fn Then '★
                Application.CutCopyMode = False
                wb.Close SaveChanges:=False
                Application.CutCopyMode = True
              End If
            Next
            
            'Workbooks(a_name).Activate '★切り替え
            Cells(gyo, 4) = data1_v   '品物data1
            Cells(gyo, 5) = data2_v   '金額data2
            
            gyo = gyo + 1


        End If
        
        fn = Dir() '2個目以降のファイル名を格納
        
    Loop
    
    'ターゲットファイルを開いてデータを取り出す------------------------------------終わり

    Application.ScreenUpdating = True 'スクリーンON
    
End Sub

３．動いてるトコロはこんなカンジ

4．補足

不明点は、ご連絡いただいて結構です。
（すぐにとか、直接）お答えできないときはすみません。
note初心者なんで、noteのコミュニケートの方法よく分かりませんが ^^；
Twitterでも。どのツイートでも返信に「noteを見た」で良いです。
出来高急増！＠assist_life　

上手くデータを拾えないことありますか？
自分がやっても上手くいかないこと一杯ありますよね。
その自分のコピーロボットです。
少しでもアシストしてくれようとしてくれる、自分のロボットです。