---

Sub PasteRowWithListInFirstCell()
    Dim DataObj As Object
    Dim rawText As String
    Dim lines() As String
    Dim linePart As String
    Dim firstCellContent As String
    Dim remainingText As String
    Dim otherParts() As String
    Dim i As Long, j As Long
    Dim tabPos As Long

    ' --- 1. Читаем буфер обмена ---
    On Error Resume Next
    Set DataObj = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    DataObj.GetFromClipboard
    rawText = DataObj.GetText
    On Error GoTo 0

    If rawText = "" Then
        MsgBox "Буфер обмена пуст или не содержит текст.", vbExclamation
        Exit Sub
    End If

    ' --- 2. Нормализуем переносы строк ---
    rawText = Replace(rawText, vbCrLf, vbLf)
    rawText = Replace(rawText, vbCr, vbLf)

    ' --- 3. Ищем первую табуляцию: разбиваем на «первую ячейку» и «остальное» ---
    tabPos = InStr(1, rawText, vbTab)

    If tabPos = 0 Then
        ' Табуляции нет — всё в первую ячейку
        firstCellContent = rawText
        remainingText = ""
    Else
        ' Часть до первой табуляции (включая переносы) = первая ячейка
        firstCellContent = Left(rawText, tabPos - 1)
        ' Всё после первой табуляции — будущие ячейки 2, 3, ...
        remainingText = Mid(rawText, tabPos + 1)
    End If

    ' Убираем возможный последний перенос строки внутри первой ячейки
    If Right(firstCellContent, 1) = vbLf Then
        firstCellContent = Left(firstCellContent, Len(firstCellContent) - 1)
    End If

    ' --- 4. Вставляем первую ячейку ---
    ActiveCell.Value = firstCellContent
    ActiveCell.WrapText = True

    ' --- 5. Обрабатываем остаток (если есть) ---
    If remainingText <> "" Then
        ' Убираем хвостовой vbLf, если он есть
        If Right(remainingText, 1) = vbLf Then
            remainingText = Left(remainingText, Len(remainingText) - 1)
        End If

        ' Теперь оставшийся текст может содержать табуляции и, возможно, переносы строк,
        ' но мы исходим из того, что остальные ячейки однострочные.
        ' Разбиваем по табуляции — это ячейки 2, 3, ...
        otherParts = Split(remainingText, vbTab)

        ' Вставляем справа от активной
        For i = LBound(otherParts) To UBound(otherParts)
            ActiveCell.Offset(0, i + 1).Value = otherParts(i)
            ActiveCell.Offset(0, i + 1).WrapText = True
        Next i
    End If
End Sub