Некоторые строки остались в Sheet1, когда они должны быть в Sheet5 - PullRequest
0 голосов
/ 10 июля 2019

Код должен разделять ячейки путем нахождения слова «BREAK» и всех строк под ним перед другим словом «BREAK».Проблема заключается в том, что «РАЗРЫВ» с первой по четвертую и строки под ним были успешно перенесены на другие листы, но последнее слово «ПРОРЫВ» было на листе 5 с 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:

enter image description here

Лист 5:

enter image description here

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...