某些行应该保留在Sheet5中时仍保留在Sheet1中

Question

该代码应该通过找到单词“ BREAK”及其下面的所有行在另一个单词“ BREAK”之前来分隔单元格。问题是，第一个到第四个“ BREAK”及其下面的行已成功转移到其他工作表，但最后一个单词“ BREAK”在Sheet5中的下面有1行，但其他行仍保留在第一张工作表中。

我已经编辑了一些部分，但仍然无法正常工作

Sub Fails()
    Dim mFind As Range
    Dim Compteur As Integer
    Dim IdSheet As Integer
    Dim ErrorBool As Boolean

    debut:
    Set mFind = Columns("A").Find("Break")
    Set mfind2 = Columns("A").Find("Break")
    If mFind Is Nothing Then
        MsgBox "There is no cell found with the text 'Break'" _
        & " in column A of the active sheet."
        Exit Sub
    End If

    firstaddress = mFind.Address
    IdSheet = 1
    Compteur = 0
    Do
            Set mfind2 = Columns("A").FindNext(mFind)
            If mfind2 Is Nothing Then
            Else:
            If mFind.Row < mfind2.Row Then
             Compteur = mfind2.Row
            End If
            If mFind.Row > mfind2.Row Then
             ErrorBool = True
            End If

            If ErrorBool = True Then
            Range(mFind, Cells(mFind.Row + 1, "A")).EntireRow.Cut
            End If
            End If

            Range("A" & mFind.Row + 1 & ":A" & Compteur - 1).EntireRow.Cut
            If mFind Is Nothing Then
            Else: IdSheet = IdSheet + 1
            End If
            Sheets("Sheet" & IdSheet & "").Select
            Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select
            ActiveSheet.Paste

    line:
        Sheets("Sheet1").Select
        Range(mFind, Cells(mFind.Row, "A")).EntireRow.Delete
        Set mFind = Columns("A").Find("Break")
        Set mfind2 = Columns("A").Find("Break")
        If mFind Is Nothing Then Exit Sub
        Set mFind = Columns("A").FindNext(mFind)

    Loop While mFind.Address <> firstaddress
End Sub

Sheet5应该在最后一个“ Break”下包含所有信息

Sheet1：

Sheet5：