---

Option Explicit

Sub PasteWordTable()
    ' Вставка таблицы из Word (уже скопированной в буфер обмена).
    ' Вставляет в активную ячейку, автоматически сдвигая существующие строки вниз.
    ' Форматирование и объединённые ячейки сохраняются.

    Dim rngStart As Range
    Dim wsTarget As Worksheet
    Dim wsTemp As Worksheet
    Dim rowCount As Long, colCount As Long

    ' 1. Проверка активной ячейки
    If ActiveCell Is Nothing Then
        MsgBox "Выделите ячейку, куда нужно вставить таблицу.", vbExclamation
        Exit Sub
    End If
    Set rngStart = ActiveCell
    Set wsTarget = rngStart.Worksheet

    ' Отключаем обновление экрана
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    ' 2. Создаём временный скрытый лист для определения размера таблицы
    On Error Resume Next
    Set wsTemp = ThisWorkbook.Worksheets("TempForWordTable")
    If Not wsTemp Is Nothing Then
        Application.DisplayAlerts = False
        wsTemp.Delete
        Application.DisplayAlerts = True
    End If
    On Error GoTo 0
    Set wsTemp = ThisWorkbook.Worksheets.Add
    wsTemp.Name = "TempForWordTable"
    wsTemp.Visible = xlSheetHidden

    ' Пробуем вставить таблицу из буфера как HTML
    On Error Resume Next
    wsTemp.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False
    If Err.Number <> 0 Then
        ' Запасной вариант – простой текст
        wsTemp.PasteSpecial Format:="Текст в кодировке Юникод", Link:=False, DisplayAsIcon:=False
    End If
    On Error GoTo 0

    ' Проверяем, вставилось ли что-то
    If wsTemp.UsedRange.Cells.Count = 1 And IsEmpty(wsTemp.Range("A1")) Then
        ' Ничего не вставилось
        Application.DisplayAlerts = False
        wsTemp.Delete
        Application.DisplayAlerts = True
        MsgBox "Буфер обмена пуст или не содержит таблицу. Скопируйте таблицу в Word (Ctrl+C) и повторите.", vbCritical
        Application.ScreenUpdating = True
        Application.EnableEvents = True
        Exit Sub
    End If

    ' Определяем размер таблицы (реальный диапазон данных)
    Dim lastCell As Range
    Set lastCell = wsTemp.Cells.SpecialCells(xlCellTypeLastCell)
    rowCount = lastCell.Row
    colCount = lastCell.Column

    ' Удаляем временный лист (буфер обмена остаётся нетронутым!)
    Application.DisplayAlerts = False
    wsTemp.Delete
    Application.DisplayAlerts = True

    ' 3. Вставляем нужное количество строк на основном листе, сдвигая всё вниз
    '    (Это не затронет столбцы за пределами таблицы, они просто сместятся вниз)
    If rowCount > 0 Then
        rngStart.Resize(rowCount).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    End If

    ' 4. Вставляем таблицу прямо из буфера обмена в активную ячейку
    rngStart.Select
    On Error Resume Next
    wsTarget.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False
    If Err.Number <> 0 Then
        wsTarget.PasteSpecial Format:="Текст в кодировке Юникод", Link:=False
    End If
    On Error GoTo 0

    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Application.EnableEvents = True

    MsgBox "Таблица вставлена успешно.", vbInformation
End Sub