概要
自分用です。
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を作成しました。
一緒に使うと便利だと思います。