Загрузка данных


Sub InsertWithAutoNumbering()
    Dim rngCopy As Range          ' Скопированный диапазон
    Dim targetCell As Range       ' Ячейка для вставки (активная)
    Dim startRow As Long          ' Строка начала вставки
    Dim rowsCount As Long         ' Количество строк в скопированном диапазоне
    Dim i As Long                 ' Счётчик
    Dim nextNum As Long           ' Следующий порядковый номер
    Dim rngAbove As Range         ' Диапазон выше места вставки в столбце A

    ' 1. Проверка: есть ли данные в буфере обмена (режим копирования)
    If Application.CutCopyMode <> xlCopy Then
        MsgBox "Сначала скопируйте нужные ячейки (Ctrl+C), а затем выполните макрос.", _
               vbExclamation, "Буфер пуст"
        Exit Sub
    End If

    ' 2. Запоминаем скопированный диапазон и активную ячейку (место вставки)
    Set rngCopy = Selection
    If rngCopy Is Nothing Then
        MsgBox "Не удалось определить скопированный диапазон.", vbExclamation, "Ошибка"
        Exit Sub
    End If

    rowsCount = rngCopy.Rows.Count          ' сколько строк будет добавлено
    Set targetCell = ActiveCell             ' место вставки (верхняя левая ячейка)
    startRow = targetCell.Row

    ' 3. Вставляем скопированные ячейки со сдвигом существующих вниз
    '    (автоматически добавится ровно rowsCount строк в нужных столбцах)
    targetCell.Insert Shift:=xlDown

    ' 4. Отключаем "бегущую рамку" копирования
    Application.CutCopyMode = False

    ' 5. Вычисляем, с какого номера продолжить нумерацию в столбце A
    nextNum = 1
    If startRow > 1 Then
        Set rngAbove = Range("A1:A" & startRow - 1)
        ' Проверяем, есть ли числовые значения выше
        If Application.WorksheetFunction.Count(rngAbove) > 0 Then
            nextNum = Application.WorksheetFunction.Max(rngAbove) + 1
        End If
    End If

    ' 6. Заполняем столбец A порядковыми номерами для всех новых строк
    For i = 1 To rowsCount
        Cells(startRow + i - 1, 1).Value = nextNum + i - 1
    Next i

    MsgBox "Готово! Вставлено " & rowsCount & " строк с нумерацией.", vbInformation, "Успех"
End Sub