---

Sub SmartPasteFromClipboard()
    Dim DataObj As Object
    Dim ClipText As String
    Dim Lines() As String
    Dim Parts() As String
    Dim CleanLines() As String
    Dim i As Long, j As Long, k As Long
    Dim HasTab As Boolean
    Dim NonEmptyCount As Long

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

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

    ' --- 2. Очищаем и разделяем на строки ---
    ' Приводим концы строк к единому виду (vbLf)
    ClipText = Replace(ClipText, vbCrLf, vbLf)
    ClipText = Replace(ClipText, vbCr, vbLf)
    Lines = Split(ClipText, vbLf)

    ' --- 3. Определяем, есть ли табуляция, и убираем пустые строки ---
    HasTab = False
    NonEmptyCount = 0
    ReDim CleanLines(UBound(Lines))
    For i = LBound(Lines) To UBound(Lines)
        If InStr(1, Lines(i), vbTab) > 0 Then HasTab = True
        If Lines(i) <> "" Or i < UBound(Lines) Then ' сохраняем пустые строки, кроме последних
            CleanLines(NonEmptyCount) = Lines(i)
            NonEmptyCount = NonEmptyCount + 1
        End If
    Next i
    If NonEmptyCount = 0 Then
        MsgBox "Буфер обмена содержит только пустые строки.", vbExclamation
        Exit Sub
    End If
    ReDim Preserve CleanLines(NonEmptyCount - 1)

    ' --- 4. Определяем сценарий и вставляем ---
    ' Сценарий 1: «Столбик» — несколько строк, табуляции нет
    If NonEmptyCount > 1 And HasTab = False Then
        ' Объединяем все строки с переносом (vbLf)
        Dim JoinedText As String
        JoinedText = Join(CleanLines, vbLf)
        ' Вставляем в активную ячейку
        With ActiveCell
            .Value = JoinedText
            .WrapText = True   ' Включаем перенос строк
        End With
        Exit Sub
    End If

    ' Сценарий 2: «Строка» — одна непустая строка и в ней есть табуляция
    If NonEmptyCount = 1 And HasTab = True Then
        Parts = Split(CleanLines(0), vbTab)
        For j = LBound(Parts) To UBound(Parts)
            ActiveCell.Offset(0, j).Value = Parts(j)
        Next j
        Exit Sub
    End If

    ' Сценарий 3: Таблица (много строк И много столбцов) или 1 строка без табуляции
    If NonEmptyCount > 1 And HasTab = True Then
        ' Это таблица — вставляем как стандартную вставку (можно иначе)
        ' Здесь просто вставляем по ячейкам
        For i = LBound(CleanLines) To UBound(CleanLines)
            Parts = Split(CleanLines(i), vbTab)
            For j = LBound(Parts) To UBound(Parts)
                ActiveCell.Offset(i, j).Value = Parts(j)
            Next j
        Next i
        Exit Sub
    Else
        ' 1 строка без табуляции — вставляем как есть
        ActiveCell.Value = CleanLines(0)
    End If
End Sub