---

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

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

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

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

    ' === Шаг 1: Определяем размер таблицы через временный лист ===
    On Error Resume Next
    Set wsTemp = wsTarget.Parent.Worksheets("TempForPaste")
    If Not wsTemp Is Nothing Then
        Application.DisplayAlerts = False
        wsTemp.Delete
        Application.DisplayAlerts = True
    End If
    On Error GoTo 0
    Set wsTemp = wsTarget.Parent.Worksheets.Add
    wsTemp.Name = "TempForPaste"
    wsTemp.Visible = xlSheetHidden

    ' Вставляем на скрытый лист, чтобы узнать размер
    On Error Resume Next
    wsTemp.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False
    If Err.Number <> 0 Then
        Application.DisplayAlerts = False
        wsTemp.Delete
        Application.DisplayAlerts = True
        MsgBox "Буфер обмена пуст или не содержит таблицу Word. Скопируйте таблицу в Word (Ctrl+C).", vbCritical
        Application.ScreenUpdating = True
        Application.EnableEvents = True
        Exit Sub
    End If
    On Error GoTo 0

    ' Определяем число строк и столбцов вставленной таблицы
    rowCount = wsTemp.UsedRange.Rows.Count
    colCount = wsTemp.UsedRange.Columns.Count

    ' Удаляем временный лист
    Application.DisplayAlerts = False
    wsTemp.Delete
    Application.DisplayAlerts = True

    ' === Шаг 2: Вставляем пустые ячейки для будущей таблицы, сдвигая данные вниз ===
    ' Сдвигаем только нужные столбцы, чтобы не задеть ячейки справа
    If rowCount > 0 And colCount > 0 Then
        rngStart.Resize(rowCount, colCount).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    End If

    ' === Шаг 3: Вставляем таблицу из буфера в освобождённое место ===
    rngStart.Select
    On Error Resume Next
    wsTarget.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False
    If Err.Number <> 0 Then
        ' Запасной вариант – простой текст
        wsTarget.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:=False
    End If
    On Error GoTo 0

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

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