---

Option Explicit

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

    Dim rngStart As Range              ' активная ячейка, куда вставляем
    Dim wsTarget As Worksheet          ' целевой лист
    Dim wsTemp As Worksheet            ' временный скрытый лист
    Dim tblRange As Range              ' диапазон вставленной таблицы на временном листе
    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

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

    ' --- 3. Вставляем таблицу на временный лист, чтобы узнать её точный размер ---
    '     Создаём временный лист (если остался с прошлого раза — удаляем)
    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 (основной формат из Word)
    On Error Resume Next
    wsTemp.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False
    If Err.Number <> 0 Then
        ' если HTML не получился, пробуем простой текст
        wsTemp.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:=False
    End If
    On Error GoTo 0

    ' Определяем реальный диапазон таблицы: CurrentRegion вокруг A1,
    ' исключая возможные пустые строки/столбцы, добавленные HTML
    On Error Resume Next
    Set tblRange = wsTemp.Range("A1").CurrentRegion
    If tblRange Is Nothing Then
        Application.DisplayAlerts = False
        wsTemp.Delete
        Application.DisplayAlerts = True
        MsgBox "Не удалось вставить таблицу. Проверьте, скопирована ли она в Word.", vbCritical
        Application.ScreenUpdating = True
        Application.EnableEvents = True
        Exit Sub
    End If
    On Error GoTo 0

    rowCount = tblRange.Rows.Count
    colCount = tblRange.Columns.Count

    ' --- 4. На целевом листе сдвигаем данные вниз (только в столбцах таблицы) ---
    '     Используем вставку ячеек со сдвигом вниз.
    On Error Resume Next
    rngStart.Resize(rowCount, colCount).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    If Err.Number <> 0 Then
        ' Если ошибка (например, объединённые ячейки мешают), пробуем вставить целые строки
        rngStart.Resize(rowCount).EntireRow.Insert Shift:=xlDown
    End If
    On Error GoTo 0

    ' --- 5. Копируем таблицу с временного листа и вставляем в освободившуюся область ---
    tblRange.Copy
    rngStart.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ' Если нужно сохранить ширину столбцов, раскомментируйте следующую строку:
    ' rngStart.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone

    Application.CutCopyMode = False

    ' --- 6. Подчищаем временный лист ---
    Application.DisplayAlerts = False
    wsTemp.Delete
    Application.DisplayAlerts = True

    ' --- 7. Восстанавливаем настройки и сообщаем об успехе ---
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    MsgBox "Таблица вставлена успешно.", vbInformation
End Sub