同じフォルダ内にある全てのブックの全てのシートからデータを抽出したい

 前提・実現したいこと

VBAでデータを抽出したいと考えております。
データ元のブックは同じフォルダ内にあり、複数のシートで構成されています。
データ元のシートの詳細な内容ですが、

①H4セルに特定の文字が入力されています
②8行目から下に、B列とM列にデータが入力されています
③各シートのフォーマットは同じですが、シートによってはB列とM列のデータが8行目のみの場合や、
複数行の場合もあります
④B列とM列のデータが複数行の場合、特定色でセルが塗りつぶされた行と塗りつぶしなしの行があります

上記の条件で、抽出したいのはデータ元の各シートのB列とM列の8行目以降で、
且つ、塗りつぶしのない行のデータのみです。
集計先では、H4セルの内容をそのままC5から下に貼り付けしていき、
B列のデータを集計先ブックのE5から下に、M列のデータをF5から下に貼り付けていきます。
データ元のシートでデータが複数行ある場合は、H4セルの内容も同じ数だけ、
集計先ブックのC列に貼り付けていきたいと思っています。
VBA初心者ですが、近々に業務で必要になり困っています。
お力添えをお願いいたします。

 発生している問題・エラーメッセージ

各シートへのループが進まず、1つ目のシートの8行目のデータのみが集計先ブックに出力されます。

 該当のソースコード

Sub データ取り込み()
    Dim myPath As String
    Dim myFile As String
    Dim FromBook As Workbook
    Dim ToSheet As Worksheet
    Dim CurRow As Long
    Dim EndRow As Long
    Dim i As Integer
    Dim MaxRow As Integer
    Dim j As Long

    Set ToSheet = ThisWorkbook.Worksheets("Sheet1") '
    myPath = ThisWorkbook.Path & "\"
    myFile = Dir(myPath & "*.xls?")

    Application.ScreenUpdating = False

    CurRow = 5
    Do Until myFile = "集計.xlsm"
        Set FromBook = Workbooks.Open(myPath & "\" & myFile)
        For i = 1 To FromBook.Worksheets.Count
            With FromBook.Worksheets(i)
                ActiveSheet.Range("$B$6:$DE$11").AutoFilter Field:=1, Operator:=xlFilterNoFill
                EndRow = .Cells(6, 2).End(xlDown).row
                For j = 8 To EndRow
                Cells(4, "H").Copy Destination:=ToSheet.Cells(CurRow, 3)
                Cells(j, "B").Copy Destination:=ToSheet.Cells(CurRow, 5)
                Cells(j, "M").Copy Destination:=ToSheet.Cells(CurRow, 6)
                j = j + 1
                Next j

            End With

            CurRow = CurRow + 1

        Next i

        Application.DisplayAlerts = False
        FromBook.Close
        myFile = Dir()
    Loop

    Application.ScreenUpdating = True

    MaxRow = Cells(Rows.Count, 3).End(xlUp).row
    Range(Cells(5, 3), Cells(MaxRow, 6)).Borders.Weight = xlMedium
    Range(Cells(5, 3), Cells(MaxRow, 6)).Borders.ColorIndex = 16
    Range(Cells(5, 3), Cells(MaxRow, 3)).HorizontalAlignment = xlCenter
    Range(Cells(5, 5), Cells(MaxRow, 5)).HorizontalAlignment = xlCenter
    Range(Cells(5, 6), Cells(MaxRow, 6)).HorizontalAlignment = xlCenter

    MsgBox "取り込み完了しました。"
End Sub