すべてのサブフォルダのすべてのファイルを調べ、1つのセルからデータを取得してマスタワークブックに貼り付けます。

Question

サブフォルダを持つディレクトリからすべてのファイルをループするものを作成します。次に、それぞれのExcelファイルを開き、合計量をコピーします。合計を含むセルが常に特定の行にあるわけではありませんが、その行の列Bにはテキスト「合計金額」が含まれています。合計を含むセルは、常に列Iにあります。セルをコピーした後、セル（i、2）内の新しいシートにマスターブック（マクロが実行されているブック）をペーストします。

セル、1）およびCell（1,2）はヘッダーです。 - あなたのモジュールの最上部にOption Explicitを配置し、コンパイルしようとすると、それが教えてくれます

Sub PaymentFileMatching() 


    Dim HostFolder As String 
    Dim f As String, i As Long, arr, sht As Worksheet 
    Dim FSO As Object, objFolder As Object, FileInFolder As Object 
    Dim wb As Workbook, Masterwb As Workbook 
    Set sht = ActiveSheet 
    Set FSO = CreateObject("Scripting.filesystemobject") 

    Dim objSubFolder As Object 
    HostFolder = "C:\Users\kxc8574\Documents\Payment Files\Payment Files (Corrected)\PE20170701\" 
    Set objFolder = FSO.GetFolder(HostFolder) 
    Set Masterwb = Workbooks("Master Template") 
    Sheets("Sheet9").Activate 
    sht.Cells(1, 1).Resize(1, 2).Value = _ 
       Array("GROUPER", "EFT_AMOUNT") 
    i = 2 
    For Each objSubFolder In objFolder.subfolders 
     For Each FileInFolder In objSubFolder.Files 
      sht.Cells(i, 1).Value = Left(FileInFolder.Name, InStr(FileInFolder.Name, "PE 2017") - 1) 
      Set wb = Workbooks.Open(objSubFolder & "\" & FileInFolder.Name) 
       For Each sht In Worksheets 
        For Each Cell In Sheets("Payment Summary").Range("B:B") 
         If Cell.Value = "Final EFT Payment Amount" Then 
          matchRow = Cell.Row 
          Cells(matchRow, 8).Copy 
          Workbooks("Master Template").Worksheets("Sheet9").Cells(i, 2).PasteSpecial xlPasteValues 
          i = i + 1 
         End If 
        Next Cell 



     Next FileInFolder 
    Next objSubFolder 

End Sub 

Answer 1

あなたはCellが何であるかを定義アレント：「ハタ」と「EFT_AMOUNT」ここ

は、私がこれまで持っているものですあなたが定義するのを忘れてしまったことがあります。定義するには、それは

Dim Cell as Range

Answer 2

未テストを使用します。

Sub PaymentFileMatching() 


    Const HostFolder As String = _ 
      "C:\Users\kxc8574\Documents\Payment Files\Payment Files (Corrected)\PE20170701\" 

    Dim i As Long 
    Dim FSO As Object, objFolder As Object, FileInFolder As Object 
    Dim wb As Workbook, Masterwb As Workbook, MasterSht As Worksheet, sht As Worksheet 
    Dim objSubFolder As Object, f As Range, fName As String 

    Set FSO = CreateObject("Scripting.filesystemobject") 
    Set objFolder = FSO.GetFolder(HostFolder) 

    Set Masterwb = Workbooks("Master Template") 
    Set MasterSht = Masterwb.Sheets("Sheet9") 

    MasterSht.Activate 
    MasterSht.Cells(1, 1).Resize(1, 2).Value = Array("GROUPER", "EFT_AMOUNT") 

    i = 2 
    For Each objSubFolder In objFolder.subfolders 
     For Each FileInFolder In objSubFolder.Files 

      fName = FileInFolder.Name 
      MasterSht.Cells(i, 1).Value = Left(fName, InStr(fName, "PE 2017") - 1) 

      Set wb = Workbooks.Open(objSubFolder & "\" & fName) 

      For Each sht In wb.Worksheets 
       Set f = sht.Columns(2).Find("Final EFT Payment Amount", , xlValues, xlWhole) 
       If Not f Is Nothing Then 
        MasterSht.Cells(i, 2).Value = f.EntireRow.Cells(8).Value 
        i = i + 1 
        Exit For 'found the value... 
       End If 
       Set f = Nothing 
      Next sht 

      wb.Close False 

     Next FileInFolder 
    Next objSubFolder 

End Sub