Sheet1のB列を2行目から順次読み込みます
ここにはurlが記載されています（フォルダ名を持ったファイル名）
その集計対象ファイルを順次開いて次の処理をします。
集計対象ファイルのレイアウトは以下の通りです。
4行目　出力対象フラグ
５行目　帳票コード
7行目以降　ID（最終行まで）
データは5行目の列の最大値まで続きます
集計対象ファイルのシート名は"データ"です
データシートは2列目から最大列までを順次処理します
7行目以降のIDを配列に追加します（1次配列）
カウントに1を加算します
5行目の帳票コードがブレイクしたならば
Thisworkbookのc"中間"シートに1行書きだします。
"中間"シートのレイアウトは以下の通りです
A列　ファイル名（フォルダ名を含む）
B列　フォルダ名（上記ファイル名の直上のフォルダ名）
C列　帳票コード
F列　出力対象フラグ
G列　ブレイクするまでの累計カウント
H列以降　ID
Sub データ集計処理()
    
    Dim ws中間 As Worksheet
    Dim wsSheet1 As Worksheet
    Dim wb対象 As Workbook
    Dim wsデータ As Worksheet
    
    Dim ファイルパス As String
    Dim ファイル名 As String
    Dim フォルダ名 As String
    Dim 帳票コード As String
    Dim 前回帳票コード As String
    Dim 出力対象フラグ As String
    Dim ID配列() As String
    Dim カウント As Long
    Dim 中間行 As Long
    
    Dim i As Long, j As Long, k As Long
    Dim 最大列 As Long
    Dim 最終行 As Long
    Dim 配列インデックス As Long
    
    ' ワークシートの設定
    Set wsSheet1 = ThisWorkbook.Worksheets("Sheet1")
    Set ws中間 = ThisWorkbook.Worksheets("中間")
    
    ' 中間シートをクリア
    ws中間.Cells.Clear
    
    ' 変数の初期化
    中間行 = 1
    前回帳票コード = ""
    カウント = 0
    ReDim ID配列(0)
    配列インデックス = 0
    
    ' Sheet1のB列を2行目から順次読み込み
    i = 2
    Do While wsSheet1.Cells(i, 2).Value <> ""
        
        ファイルパス = wsSheet1.Cells(i, 2).Value
        
        ' ファイル名とフォルダ名を取得
        ファイル名 = Dir(ファイルパス)
        フォルダ名 = Mid(ファイルパス, InStrRev(ファイルパス, "\", InStrRev(ファイルパス, "\") - 1) + 1, _
                     InStrRev(ファイルパス, "\") - InStrRev(ファイルパス, "\", InStrRev(ファイルパス, "\") - 1) - 1)
        
        ' 対象ファイルを開く
        On Error Resume Next
        Set wb対象 = Workbooks.Open(ファイルパス)
        On Error GoTo 0
        
        If wb対象 Is Nothing Then
            MsgBox "ファイルを開けませんでした: " & ファイルパス
            GoTo NextFile
        End If
        
        ' データシートを取得
        On Error Resume Next
        Set wsデータ = wb対象.Worksheets("データ")
        On Error GoTo 0
        
        If wsデータ Is Nothing Then
            MsgBox "データシートが見つかりませんでした: " & ファイルパス
            wb対象.Close False
            GoTo NextFile
        End If
        
        ' 最大列を取得（5行目の列の最大値まで）
        最大列 = wsデータ.Cells(5, wsデータ.Columns.Count).End(xlToLeft).Column
        
        ' 2列目から最大列まで順次処理
        For j = 2 To 最大列
            
            ' 出力対象フラグと帳票コードを取得
            出力対象フラグ = wsデータ.Cells(4, j).Value
            帳票コード = wsデータ.Cells(5, j).Value
            
            ' 帳票コードが空の場合はスキップ
            If 帳票コード = "" Then GoTo NextColumn
            
            ' 帳票コードがブレイクした場合の処理
            If 前回帳票コード <> "" And 前回帳票コード <> 帳票コード Then
                Call 中間シートに出力(ws中間, 中間行, ファイルパス, フォルダ名, 前回帳票コード, _
                                  出力対象フラグ, カウント, ID配列, 配列インデックス)
                中間行 = 中間行 + 1
                
                ' 配列とカウントをリセット
                ReDim ID配列(0)
                配列インデックス = 0
                カウント = 0
            End If
            
            ' 7行目以降の最終行を取得
            最終行 = wsデータ.Cells(wsデータ.Rows.Count, j).End(xlUp).Row
            
            ' 7行目以降のIDを配列に追加（IDが空白の場合はスキップ）
            For k = 7 To 最終行
                If wsデータ.Cells(k, j).Value <> "" Then
                    ReDim Preserve ID配列(配列インデックス)
                    ID配列(配列インデックス) = wsデータ.Cells(k, j).Value
                    配列インデックス = 配列インデックス + 1
                    カウント = カウント + 1
                End If
            Next k
            
            ' 7行目のIDが空白の場合は列全体をスキップ
            If wsデータ.Cells(7, j).Value = "" Then GoTo NextColumn
            
            前回帳票コード = 帳票コード
            
NextColumn:
        Next j
        
        ' ファイルを閉じる
        wb対象.Close False
        Set wb対象 = Nothing
        Set wsデータ = Nothing
        
NextFile:
        i = i + 1
    Loop
    
    ' 最後のデータを出力
    If 前回帳票コード <> "" And カウント > 0 Then
        Call 中間シートに出力(ws中間, 中間行, ファイルパス, フォルダ名, 前回帳票コード, _
                          出力対象フラグ, カウント, ID配列, 配列インデックス)
    End If
    
    MsgBox "処理が完了しました。"
    
End Sub

' 中間シートに出力するサブルーチン
Private Sub 中間シートに出力(ws As Worksheet, 行 As Long, ファイルパス As String, _
                        フォルダ名 As String, 帳票コード As String, 出力対象フラグ As String, _
                        カウント As Long, ID配列() As String, 配列サイズ As Long)
    
    Dim i As Long
    
    ' A列: ファイル名（フォルダ名を含む）
    ws.Cells(行, 1).Value = ファイルパス
    
    ' B列: フォルダ名
    ws.Cells(行, 2).Value = フォルダ名
    
    ' C列: 帳票コード
    ws.Cells(行, 3).Value = 帳票コード
    
    ' F列: 出力対象フラグ
    ws.Cells(行, 6).Value = 出力対象フラグ
    
    ' G列: 累計カウント
    ws.Cells(行, 7).Value = カウント
    
    ' H列以降: IDの配列
    For i = 0 To 配列サイズ - 1
        If ID配列(i) <> "" Then
            ws.Cells(行, 8 + i).Value = ID配列(i)
        End If
    Next i
    
End Sub