run-time error '1004' (Application-defined or object-defined error)

[Oldy7]

Там ошибка с нулем по количеству мест, это исправлено. Сейчас исправлю весь текст макроса по Вашему примеру. Почему-то при первом варианте все копировалось в cells(1,10) без изменения значения переменной dels.

Теперь ошибка та же ,но в дебугере на желтым выделена строка с присвоением значения num = .Cells(a + 1, 5)

Макрос сейчас имеет такой вид:
Sub asd()
Dim pn As String
Dim npl As Integer
Dim pla As Integer
Dim num As Integer
Dim dels As Integer
dels = 1
Sheets("asd").Range(Cells(1, 10), Cells(4000, 17)).ClearContents
For a = 1 To 188 Step 1
With Sheets("asd")
num = .Cells(a + 1, 5)
npl = .Cells(a + 1, 3)
pla = .Cells(a + 1, 4)
pn = .Cells(a + 1, 1)
End With
If npl < 1 Then
GoTo endfor
End If
If pla < 1 Then
GoTo endfor
End If
If pla < npl Then
npl = pla
End If
With Sheets("ctok")
.Range(.Cells(num, 1), .Cells(num + npl - 1, 7)).Copy Destination:=Sheets("asd").Range(Ce lls(dels, 10), Cells(dels + npl - 1, 17))
End With
del = dels + npl
endfor:
Next a
End Sub

[VictorM]

Я Вам уже говорил об этом.
Нет искомого значения на листе2. (Обратите внимание, чему равно а в желтой строке.)
И еще странность заметил
del = dels + npl
может всеже
dels = dels + npl
?
потому и

все копировалось в cells(1,10) без изменения значения переменной dels.

просто переменная del у Вас больше нигде не участвует

[Oldy7]

Сообщение от VictorM

Я Вам уже говорил об этом.
Нет искомого значения на листе2. (Обратите внимание, чему равно а в желтой строке.)
И еще странность заметил
del = dels + npl
может всеже
dels = dels + npl
?
потому и

If pla < 1 Then
GoTo endfor
End If

Макрос содержимое стока поставщика теперь также проверяет. За найденную опечатку спасибо!

[Oldy7]

Все ОК. Проблема побеждена - не правильный подобран тип переменной для num.

Всем огромное спасибо!

П.С.: Осталось убедить макрос учитывать заблокированные товарные позиции. Попробую сначала через формулы, но даже на-вскидку вижу сложности...

[Oldy7]

Еще раз Доброго времени суток!

Нет предела совершенству) Я решил пойти дальше (если уж автоматизировать, то по-максимуму).
Задачи:
- поиск и сопоставление материалов в списке (сгенерированным формулами) на листе "asd" и стоке поставщика (лист "ctok") - реализовано
- исключить заблокированные строки стока поставщика при формировании заявки - готово
- очиска содержимого ячеек на листе "Placement_Form" (Range(Cells(1,5) Cells(1000,12))) - не удалось
- одновременное копирование строк из стока на лист "asd" и и лист "Placement_Form" - ни черта не вышло
- сохранение сгенерированного заказа в файл с расширением *csv - даже не пытался, знаю, что мне пока это не по зубам

Если это возможно, то просьба оказать помощь

П.С.: По пунктам программы 3,4 вылезала ошибка 1004 при попытке пойти уже проторенным путем.

[tae1980]

Вот моя процедура сохранения координат в CSV. Он простая, думаю разберешься и адаптируешь под себя:

Sub SavePointCsv()
' Процедура сохраняет координаты точек участков и частей в текстовый файл.
'Формат файла: XтабY
'Выводится окно с запросом имени текстового файла.
    On Error Resume Next: Err.Clear
    'Описываем листы с исходными данным для активного МежПлана. Описание происходит по имени листа, нужно следить что бы оно не менялось!!!
    Set Участки = ActiveWorkbook.Worksheets("Участки")
    Set Части = ActiveWorkbook.Worksheets("Части")
    
    newDirName = GetFolderPath("Выберите папку для сохранения CSV файлов", ActiveWorkbook.path)
    'Сохраняем координаты участков
    For n = 1 To Evaluate(ActiveWorkbook.Names("Участки_всего").Value)
        Смещение_уч = ((-1 + n) * 6) + 3        'Расчитываем смещаемся на начало текущего участка.
        newFilename = Replace_path(Выбор(Участки, Смещение_уч, Уч_КадНомер))
        If Left(newFilename, 1) = "-" Then newFilename = Right(newFilename, Len(newFilename) - 1)
        newFilename = newDirName & newFilename
        Open newFilename For Output As #1
        If Err Then MsgBox "Не удается сохранить файл c точками:" & vbCrLf & newFilename, vbCritical: Exit Sub
        For i = 1 To Выбор(Участки, Смещение_уч, Уч_Точки)
             Print #1, Replace(Format(Участки.Cells(УчЧс_КоордНачало + i, Смещение_уч + 2).Value, "#.00"), ",", ".") _
& vbTab & Replace(Format(Участки.Cells(УчЧс_КоордНачало + i, Смещение_уч + 3).Value, "#.00"), ",", ".")
        Next i
        Close #1
    Next n
    'Сохраняем координаты частей
    For n = 1 To Evaluate(ActiveWorkbook.Names("Части_всего").Value)
        Смещение_чс = ((-1 + n) * 6) + 3        'Расчитываем смещаемся на начало текущего участка.
        newFilename = Replace_path(Выбор(Части, Смещение_чс, Чс_КадНомер))
        If Left(newFilename, 1) = "-" Then newFilename = Right(newFilename, Len(newFilename) - 1)
        newFilename = newDirName & newFilename
        Open newFilename For Output As #1
        For i = 1 To Выбор(Части, Смещение_чс, Чс_Точки)
             Print #1, Replace(Format(Части.Cells(УчЧс_КоордНачало + i, Смещение_чс + 2).Value, "#.00"), ",", ".") _
& vbTab & Replace(Format(Части.Cells(УчЧс_КоордНачало + i, Смещение_чс + 3).Value, "#.00"), ",", ".")
        Next i
        Close #1
    Next n
End Sub

Для тебя важно то что находиться между "Open newFilename For Output As #1" и "Close #1"

[VictorM]

- очиска содержимого ячеек на листе "Placement_Form" (Range(Cells(1,5) Cells(1000,12))) - не удалось

- одновременное копирование строк из стока на лист "asd" и и лист "Placement_Form" - ни черта не вышло

Что именно "не удалось" и "ни черта не вышло" из файла непонятно, поэтому предположу, что можно сделать так:
1.

Sub tt()
    With Sheets("Placement_Form")
        .Range(.Cells(1, 5), .Cells(4000, 17)).ClearContents
    End With
End Sub

2. добавьте в код

With Sheets("ctok")
            .Range(.Cells(num, 1), .Cells(num, 7)).Copy Destination:=Sheets("asd").Range(Cells(dels, 10), Cells(dels, 17))
            .Range(.Cells(num, 1), .Cells(num, 7)).Copy Destination:=Sheets("Placement_Form").Range(Cells(dels, 10), Cells(dels, 17))
        End With

[VictorM]

По поводу

- сохранение сгенерированного заказа в файл с расширением *csv

поищите по форуму, были такие темы неоднократно.
И вот еще гляньте Экспорт таблицы (диапазона ячеек) в CSV

[Oldy7]

Огроменное спасибо! Буду пробовать.

П.с.: Интересно, а две процедуры (два макроса) можно совместить? Полагаю, да, но все же...

Кстати, подобное я по копированию и очистке я пытался сделать, вылезала ошибка 1004. Поэтому и удалил из тела рабочего макроса.

With Sheets("ctok")
.Range(.Cells(num, 1), .Cells(num, 7)).Copy Destination:=Sheets("asd").Range(Ce lls(dels, 10), Cells(dels, 17))
.Range(.Cells(num, 1), .Cells(num, 7)).Copy Destination:=Sheets("Placement_Form ").Range(Cells(dels, 10), Cells(dels, 17))
End With

Как и ожидалось не работает. В дебугере на второй строке с Range стоит маркер и вся строка выделена желтым.

[VictorM]

Если коротко - можно.
А дальше нужно смотреть что и как.