---

Option Explicit

Sub PasteWordTable_WithShift()
    ' Вставка таблицы из Word с автоматической вставкой строк сверху.
    ' Таблица размещается, начиная с активной ячейки, данные ниже сдвигаются.
    Dim rngStart As Range, wsTarget As Worksheet
    Dim wsTemp As Worksheet
    Dim rowCount As Long, colCount As Long
    Dim lastRow As Long, lastCol 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

    ' Создаём временный лист
    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

    ' Вставляем таблицу из буфера на временный лист
    On Error Resume Next
    wsTemp.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False
    If Err.Number <> 0 Then
        wsTemp.PasteSpecial Format:="Текст в кодировке Юникод", Link:=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 "Буфер обмена пуст или не содержит таблицу.", vbCritical
        GoTo CleanExit
    End If

    ' Определяем реальные размеры таблицы (без пустых строк)
    On Error Resume Next
    lastRow = wsTemp.Cells.Find("*", wsTemp.Range("A1"), xlFormulas, , xlByRows, xlPrevious).Row
    lastCol = wsTemp.Cells.Find("*", wsTemp.Range("A1"), xlFormulas, , xlByColumns, xlPrevious).Column
    On Error GoTo 0
    If lastRow = 0 Then lastRow = 1
    If lastCol = 0 Then lastCol = 1
    rowCount = lastRow
    colCount = lastCol

    ' Вставляем пустые строки на основном листе
    If rowCount > 0 Then
        rngStart.Resize(rowCount).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    End If

    ' Копируем таблицу с временного листа
    wsTemp.Range(wsTemp.Cells(1, 1), wsTemp.Cells(rowCount, colCount)).Copy

    ' Вставляем в освободившуюся область
    On Error Resume Next
    rngStart.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    If Err.Number <> 0 Then rngStart.Paste
    On Error GoTo 0

    Application.CutCopyMode = False

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

CleanExit:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    If Err.Number = 0 Then MsgBox "Таблица вставлена.", vbInformation
End Sub