Sub Split_()
    Dim a, j&, r As Range, c As Range, rr As Range, s$
    [A1].CurrentRegion.Offset(1).ClearContents
    a = Split([A1], Chr(10))
    Application.ScreenUpdating = 0
    With Sheets(1)
        For j = 0 To UBound(a)
            .Cells(j + 2, 1) = a(j)
        Next
        Set r = .Range(Cells(2, 1), Cells(2, 1).End(xlDown))
        With r
            For j = .Cells.Count To 1 Step -1
                If Mid(.Cells(j), 1, 11) = "З1 11/03/19" Then
                    .Cells(j) = .Cells(j) & s & Chr(10): s = ""
                Else
                    s = Chr(10) & .Cells(j) & s
                    If rr Is Nothing Then Set rr = .Cells(j) Else Set rr = Union(rr, .Cells(j))
                End If
            Next
        End With
        rr.EntireRow.Delete
    End With
End Sub

Sub Split_()
    Dim a, b, ii&, j&, k&, r As Range
    Set r = Sheets(1).[A2].CurrentRegion
    Sheets(2).Cells.ClearContents
    With r
        For ii = 1 To r.Count
            a = Split(.Cells(ii), "З1 11/03/19")
            ReDim b(UBound(a), 1)
            b = Application.Transpose(a)
            For j = 1 To UBound(b)
                Sheets(2).Cells(j + k, 1) = "З1 11/03/19" & b(j, 1)
            Next
            k = k + j - 1
        Next
    End With
    Sheets(2).Activate
End Sub