列ヘッダーを使用して多数のワークブックのデータをマスターにコピー

Question

以下のコードは、ONEブックからマスター（Source.xlsx）へデータをコピーする際に、きれいに動作しています。このコードを変更して、多くのブックに同じコードを適用できますか？ ソース内の列ヘッダーを使用して、そのテーブルに追加する1つのディレクトリ内の多くのファイルのデータが必要です。私が常にコピーしているファイルには、私が探しているヘッダーがありますが、別の列にあります。 追加された列（マスターファイルの場所>サブフォルダ>サブフォルダ2>コピー元のファイル）に保存されたサブフォルダとサブフォルダ2とともに、データがコピーされたファイル名を保存すると非常に便利です。 StackOverflowの指導者を助けてもらえますか？

Sub CopyByHeader() 

    Dim CurrentWS As Worksheet 
    Set CurrentWS = ActiveSheet 

    Dim SourceWS As Worksheet 
    Set SourceWS = Workbooks("vavc1.valor.carnival.com_2017-10-30.xls").Worksheets(1) 
    Dim SourceHeaderRow As Integer: SourceHeaderRow = 1 
    Dim SourceCell As Range 

    Dim TargetWS As Worksheet 
    Set TargetWS = Workbooks("Source.xlsx").Worksheets(1) 
    Dim TargetHeader As Range 
    Set TargetHeader = TargetWS.Range("A1:K1") 

    Dim RealLastRow As Long 
    Dim SourceCol As Integer 

    SourceWS.Activate 
    For Each Cell In TargetHeader 
     If Cell.Value <> "" Then 
      Set SourceCell = Rows(SourceHeaderRow).Find _ 
       (Cell.Value, LookIn:=xlValues, LookAt:=xlWhole) 
      If Not SourceCell Is Nothing Then 
       SourceCol = SourceCell.Column 
       RealLastRow = Columns(SourceCol).Find("*", LookIn:=xlValues, _ 
       SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 
       If RealLastRow > SourceHeaderRow Then 
        Range(Cells(SourceHeaderRow + 1, SourceCol), Cells(RealLastRow, _ 
         SourceCol)).Copy 
        TargetWS.Cells(2, Cell.Column).PasteSpecial xlPasteValues 
       End If 
      End If 
     End If 
    Next 

    CurrentWS.Activate 

End Sub 

Answer 1

ループ内で動作するコードをラップする必要があります。 folder.filesの各ブックについて、コードを実行します。

この投稿は、フォルダ内のワークブックを反復する方法を教えてくれます：

Loop through files in a folder using VBA?