'В выделенном диапазоне разбить содержимое ячеек по разделителю вниз в автоматически добавляемые строки
'Автор: webley
'Редактор: JayBhagavan
'Адаптация под сложный перенос и коррекция: JeyCi
'Тема на сайте: http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=1&TID=80210&TITLE_SEO=80210-razbit-tekst-v-yacheyke-po-strokam-cherez-proizvolnyy-razdelitel#postform
'=====================================================================================================================================================================================
Option Explicit
Sub TextOnRowsInRange_BASE2()
Dim cl As Range, rngTOR As Range, rngTmp As Range
Dim strTmp$, DelimTOR$
Dim Arr() As String
Dim i&, n&, j&, k&, a&, max&

    If DelimTOR = "" Then Exit Sub
    
    If rngTOR.Columns.Count > 20 Or rngTOR.Rows.Count > 10000 Or rngTOR.Cells.Count > 100000 Then
        MsgBox "Слишком много выделено!", vbExclamation, "Ошибка выделения"
        Exit Sub
    End If

Application.ScreenUpdating = 0
    For i = rngTOR.Rows.Count To 1 Step -1
'===
        max = 0
        For j = 1 To rngTOR.Columns.Count
                strTmp = rngTOR(i, j).Value & DelimTOR
                   Arr = Split(strTmp, DelimTOR)
                   a = UBound(Arr)
            max = IIf(max > a, max, a)
        Next
        If max <= 1 Then GoTo nx
'===
        rngTOR(i, 1).Offset(1, 0).Resize(max - 1).EntireRow.Insert Shift:=xlDown ', CopyOrigin:=xlFormatFromLeftOrAbove
   For j = 1 To rngTOR.Columns.Count
            With rngTOR(i, j)
            If InStr(rngTOR(i, j), DelimTOR) Then
                strTmp = .Value '& DelimTOR
                Arr = Split(strTmp, DelimTOR)
                a = UBound(Arr)
                    Set rngTmp = .Resize(a)
                    For k = 0 To a
                        rngTmp(k + 1, 1).Value = Arr(k)
                    Next k
            End If
            End With
        Next j
'===
nx:
    Next i
Application.ScreenUpdating = 1
End Sub
'=======================================================================================================================
Sub TextOnRowsInRange_Choose2()
Dim rngTOR As Range
Dim DelimTOR$

DelimTOR = InputBox("Введите символ-разделитель")
    If DelimTOR = "10" Then DelimTOR = Chr(10) 'ввести "10" для использования в качестве разделителя "перенос строки"
Set rngTOR = Selection
Application.Run "TextOnRowsInRange_BASE2"
End Sub