Код должен разделять ячейки путем нахождения слова «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:
Лист 5: