概要

自分用です。
Excelにパスを記載したファイルを上から順番に開いて、表をコピーしていきます。

・行ごとコピペするだけなのでカラムごとの対応はしていません。
・開始する行を指定して行をコピーしていきます。
・開始する行は完全一致で検索をかけるのでファイルごとに開始位置が異なっていても問題ありません。
・コピー後１列名にコピー元のファイル名を記載します。

シートの作成

シートは２シート作成します。
・「ファイル一覧」シート
・「取得結果」シート

表は「ファイル一覧」シートに2つ作成します。
表１　コピー開始行の指定
A列にタイトルを記載
B1セル：検索文字（完全一致）
B2セル：数値（検索したセルの行＋Ｂ2セルの数値　からコピーを開始する。空白行になるまでコピーを続ける）

表２　検索対象ファイル一覧
ヘッダは１行目、値は２行目から記載します。
D列：操作の要否（操作不要なら×を記載）
E列：操作したいファイルのパス
F列：結果を記載する（今回はコピーした行数）

図　「ファイル一覧」シート

※「取得結果」シートにはマクロを実行した分だけ行が継ぎ足されていきます。
最初から集計しなおしたい場合は値を手動で消す必要があります。

VBAコード

Moduleは2つ作成します。

Module1
ファイルを開き処理を実施する関数を呼び出す

Sub Excel表集計()
Application.ScreenUpdating = False
Dim ファイル一覧シート As Variant
Set ファイル一覧シート = ThisWorkbook.Sheets("ファイル一覧")
Dim 操作ブック As Workbook
Dim 結果 As String

On Error GoTo エラー

For filei = 2 To ファイル一覧シート.Range("E10000").End(xlUp).Row

    ファイル一覧シート.Range("F" & filei).Value = "未処理"
    
     If Not ファイル一覧シート.Range("D" & filei).Value = "×" Then
        Workbooks.Open ファイル一覧シート.Range("E" & filei)
        Set 操作ブック = ActiveWorkbook
        '処理の実行
        結果 = ファイル操作(操作ブック)
        操作ブック.Close SaveChanges:=False
        ファイル一覧シート.Range("F" & filei).Value = 結果
      End If
      GoTo skip

エラー:
    ファイル一覧シート.Range("F" & filei).Value = "ファイル開かず"
skip:
Next
End Sub

Module1
ファイルを開き処理を実施する関数を呼び出す

Function ファイル操作(ByRef 操作ブック As Workbook) As String

On Error GoTo エラー

'好きな処理を記載

Dim ファイル一覧シート As Variant
Set ファイル一覧シート = ThisWorkbook.Sheets("ファイル一覧")
Dim 取得結果シート As Variant
Set 取得結果シート = ThisWorkbook.Sheets("取得結果")

Dim 結果 As String
結果 = "結果なし"
Dim コピーした行数 As Integer
    コピーした行数 = 0
Dim 操作シート As Worksheet
Dim 操作対象検索セル As Range, 操作行 As Integer


    For Each 操作シート In 操作ブック.Worksheets
        
        Set 操作対象検索セル = 操作シート.Cells.Find(ファイル一覧シート.Range("B1"), LookAt:=xlWhole)
                        
        If Not 操作対象検索セル Is Nothing Then
            操作行 = 操作対象検索セル.Row + ファイル一覧シート.Range("B2")
            
            Do While Len(操作シート.Cells(操作行, 操作対象検索セル.Column)) > 0
                Dim 貼り付け先行 As Integer
                貼り付け先行 = 取得結果シート.Range("A10000").End(xlUp).Row + 1
                操作シート.Rows(操作行).Copy Destination:=取得結果シート.Rows(貼り付け先行)
                取得結果シート.Range("A" & 貼り付け先行).Insert (xlShiftToRight) 'セルを挿入　右にずれる
                取得結果シート.Range("A" & 貼り付け先行) = 操作ブック.Name
                コピーした行数 = コピーした行数 + 1
                操作行 = 操作行 + 1
            Loop
        End If
        

    Next 操作シート
    
    If コピーした行数 > 0 Then
        結果 = コピーした行数
    End If


ファイル操作 = 結果
Exit Function

エラー:
ファイル操作 = "エラー発生"

End Function

おまけ

集計した表の表記ゆれをチェックできるVBAを作成しました。
一緒に使うと便利だと思います。

VBAテンプレート　表記ブレチェッカー