Выбрать дату в календареВыбрать дату в календаре

Страницы: 1
Ошибка при повторном запуске макроса: Method 'Insert' of object 'Range' failed error
 
Цитата
что не устравивает?
Цель макроса была несколько сложнее.
Скопировать шаблон состоящий из 3 строчек, который в свою очередь состоял из 2 уровней (1-й - заголовок и формулы суммирования и 2-й уровень- 2 строчки с данными)).
Вставить шаблон со сдвигом в заданном месте и вставить заданное кол-во строк.
Пользователь макроса просто вводит сколько строк в лоте (20, 30 не важно) и все.
Недостающие строчки встают между 1 и 2 строчкой второго уровня (что бы формулы суммирования не сломалась).
Далее макрос заполняет формулы (я этот участок не выкладывал).

Изначально прописал сценарий через "If...Else", но появлялась ошибка через раз. Пользователь  artemkau88 предложил конструкцию "Select case".
Внедрил ее к себе, прогнал код около 40 раз и ошибка не появилась.
Все прекрасно только я не понял почему конструкция если приводила к ошибке или в чем дело.
Ошибка при повторном запуске макроса: Method 'Insert' of object 'Range' failed error
 
Вставка происходит со сдвигом "Прочих" вниз. Т.е. прочие начинались с 24 строки после insert начинаются с 27.
В данный момент ошибка появилась на 3 раз.

Диапазоны показывает перед тем как выдать ошибку. Если не сложно поясните, как использовать эту информацию.
Код
wsData.Range("шаблон").Copy
MsgBox wsData.Range("шаблон").Address
MsgBox wsData.Range("Прочие").Address
wsData.Range("Прочие").EntireRow.Insert
Application.CutCopyMode = False
Ошибка при повторном запуске макроса: Method 'Insert' of object 'Range' failed error
 
Копирую именной диапазон (шаблон) и вставляю перед именным диапазоном (Прочие)
Ошибка при повторном запуске макроса: Method 'Insert' of object 'Range' failed error
 
Ошибку отмечает в 13 строке кода.
Jack Famous имеете в виду использовать"On Error" или что-то другое?
Ошибка при повторном запуске макроса: Method 'Insert' of object 'Range' failed error
 
Цитата
Можете максимально упростить код, чтобы при этом оставалась ошибка?
Не знаю актуально или нет.
Код
Option Explicit

Sub NewKP()
Dim wsData As Worksheet

Set wsData = ThisWorkbook.Worksheets("Затраты")

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

wsData.Range("шаблон").Copy
wsData.Range("Прочие").EntireRow.Insert
Application.CutCopyMode = False

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

End Sub
rafsinaga, если закомментировать все Application то ошибка не появляется.
Ошибка при повторном запуске макроса: Method 'Insert' of object 'Range' failed error
 
Jack Famous, спасибо за советы! Возьму на вооружение.
Ошибка при повторном запуске макроса: Method 'Insert' of object 'Range' failed error
 
artemkau88, интегрировал Вашу структуру ("Select Case") в свою задачу, после 20 попыток ошибка не появилась, огромное Вам спасибо!
Ниже рабочий код, вдруг кому пригодится.
Добавил еще один именной диапазон ("СтрочкаШаблона") для копирования
Код
Option Explicit

Sub Тест_1()

Dim wsData As Worksheet
Dim varRow, RowToPaste As Variant, rngMyCell As Range, shablon, i, ColumnToCopy

shablon = "шаблон"

Set wsData = ActiveWorkbook.Worksheets("Затраты")
varRow = Application.InputBox("Введите сколько строк в КП" & vbCrLf, "Добавление нового КП", Type:=1)

    If varRow = "" Then
        MsgBox "Не ввели кол-во строк", vbCritical
        Exit Sub
    ElseIf varRow <= 1 Then
        MsgBox "Слишком мало строк", vbCritical
        Exit Sub
    End If
    
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

With wsData
    Select Case varRow
        Case Is = 2
        Set RowToPaste = .Range("шаблон")
        Set rngMyCell = Range("КодКП").Find(shablon)
        
        RowToPaste.Copy
        .Range("Прочие").Rows.EntireRow.Insert Shift:=xlDown
        
        Set rngMyCell = Range("Код_КП").Find(shablon)
        rngMyCell.Offset(1, 0).Rows(1).EntireRow.Delete Shift:=xlDown
        
        Case Is = 3
        Set RowToPaste = .Range("шаблон")
        RowToPaste.Copy
        .Range("Прочие").Rows.EntireRow.Insert Shift:=xlDown
        
        Case Is > 3
        Set RowToPaste = .Range("шаблон")
        RowToPaste.Copy
        .Range("Прочие").Rows(1).EntireRow.Insert Shift:=xlDown
        
        i = 4
        Set ColumnToCopy = .Range("СтрочкаШаблона").Rows
        Do
        ColumnToCopy.Copy
        Set rngMyCell = Range("Код_КП").Find(shablon)
        rngMyCell.Offset(2, 0).EntireRow.Insert Shift:=xlDown
        i = i + 1
        
        Loop While i <= varRow
     End Select
End With
Application.CutCopyMode = False

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

End Sub
Изменено: Игорь Песоцкий - 15.11.2021 15:18:33
Ошибка при повторном запуске макроса: Method 'Insert' of object 'Range' failed error
 
, последние пол часа этим занимался) Ваш код выдает ошибку '424' object required отмечая строчку 26 (что бы вызвать нужно ввести цифру 3), но это не страшно.
Я правильно уловил, что ошибка описанная мною вызвана конструкцией if...else?  
Ошибка при повторном запуске макроса: Method 'Insert' of object 'Range' failed error
 
Цитата
Если отбросить все специфические особенности макроса, то в сухом остатке проблема в том, что появляется ошибка 1004 «метод Insert из класса Range завершён неверно», я правильно понял?
Правильно. Словно в памяти компьютера остаётся прошлые данные диапазонов (моя теория) и происходит ошибка. И всегда программа отмечает строчку с кодом insert.
Ошибка при повторном запуске макроса: Method 'Insert' of object 'Range' failed error
 
Цитата
То есть мы всегда вставляем последние 2 строки диапазона Шаблон?
Верно. Просто на первом уровне формула сумма, поэтому по моей схеме, если оператору необходимо добавить лот с 2 строчками, макрос копирует весь шаблон и удаляет первую строчку второго уровня. Если необходимо вставить больше 3, тогда макрос копирует первую строчку второго уровня шаблона и вставляет ее между ранее вставленными.
Как то запутанно получилось, попробуйте прогнать через отладчик (F8), будет нагляднее.
Цитата
У вас в диапазоне "Шаблон" 3 строки: первая, как я понял, заголовок, вторая и третья - это уровни
В диапазоне шаблон всего два уровня (1 заголовок и сумма, 2 позиция в составе этого лота). В моем примере первого уровня 1 строчка, 2 уровня две строчки. Сделано для того, что бы при добавление новых строк не пришлось перепротягивать формулы
Изменено: Игорь Песоцкий - 15.11.2021 09:03:54
Ошибка при повторном запуске макроса: Method 'Insert' of object 'Range' failed error
 
Книга/листы не защищены. Ошибка появляется и в общем и в монопольном доступе.

Используя шаблон (последние строчки в таблице) вставить заданное кол-во строк в нужное место.
Сам шаблон имеет два уровня, на первом заголовок, на втором состав лота. Формулы первого и второго уровня отличаются.
Ошибка при повторном запуске макроса: Method 'Insert' of object 'Range' failed error
 
Книга/листы не защищены. Ошибка появляется и в общем и в монопольном доступе.
Изменено: Игорь Песоцкий - 15.11.2021 04:59:02
Ошибка при повторном запуске макроса: Method 'Insert' of object 'Range' failed error
 
Добрый день!

Задача макроса: вставлять n-ое кол-во строк (задается Inputbox) перед именным диапазоном.
Проблема: при повторном запуске (редко и в первый раз) выдает ошибку "Method 'Insert' of object 'Range' failed error".
Отмечает строчки (либо-либо):
  1. wsWorkSheet.Range("Прочие").EntireRow.Insert
  2. rngMyCell.Offset(2, 0).EntireRow.Insert
Вопрос: почему так происходит и как устранить.
Код
Sub Файл_1()
Dim wsWorkSheet As Worksheet
Set wsWorkSheet = Workbooks("Файл 1.xlsm").Worksheets("Затраты")

Dim varRow As Variant

varRow = InputBox("Введите сколько строк добавить. Для выхода, ничего не вводите и нажмите ОК", "Добавление нового лота")

    If varRow = "" Then
        MsgBox "Не ввели кол-во строк", vbCritical
        Exit Sub
    ElseIf varRow <= 1 Then
        MsgBox "Слишком мало строк", vbCritical
        Exit Sub
    End If
    
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

wsWorkSheet.Range("Шаблон").Copy                    'Копирование именного диапазона
wsWorkSheet.Range("Прочие").EntireRow.Insert        'Вставка скопированного перед именным диапазоном
Application.CutCopyMode = False

Dim strShablon As String, rngMyCell As Range, i As Long

strShablon = "Шаблон"

Set rngMyCell = wsWorkSheet.Range("Код_КП").Find(strShablon)

    If varRow = 2 Then
        rngMyCell.Offset(1, 0).Rows("1:1").EntireRow.Delete
        
    ElseIf varRow > 2 Then
        For i = 4 To varRow

        Range("Шаблон").Offset(1, 0).Rows("1:1").Copy
        rngMyCell.Offset(2, 0).EntireRow.Insert

        Next
    End If
    
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

MsgBox "Тест завершен!", vbInformation

End Sub

Как вызвать ошибку:
Если добавить например 8 (кол-во любое) строк, потом удалить и снова добавить уже меньше появляется ошибка. Требуется до 8 попыток.

Методы которые не помогли:
  • Изменение переменных
  • Вместо именного диапазона вставка по конкретной строчке, найденной ".Find"
  • Замена "EntireRow.Insert" на "Insert"
  • Указание диапазонов с адресом от книги до листа
Временно нашлось решение после первого добавления и удаления сохранять файл, но случаются "вылеты при первом запуске"

Буду рад любому совет.

Microsoft Office 2016
Страницы: 1
Наверх