Как алгоритм перевести в код VBA

[valerij]

Мужики!
Хотя мой вопрос полностью решился, но все же, меня мучает вопрос(как самого прилежного ученика), как перевести в код, сей алгоритм, какие в нем "+", "-".
Спасибо.

Сделаем одно условие, всегда, ввод № -ра, будет начинается с первой строки и подряд

Алгоритм для 1-го дня
x=1 где х, счетчик совпадений строк

Если I31 = 0, то перейти на I(31+48), иначе, x=x+1, копировать в Лист "НАКЛ" в столбец А(х)
Если I32 = 0, то перейти на I(31+48), иначе, x=x+1, копировать в Лист "НАКЛ" в столбец А(х)
Если I33 = 0, то перейти на I(31+48), иначе, x=x+1, копировать в Лист "НАКЛ" в столбец А(х)
Если I34 = 0, то перейти на I(31+48), иначе, x=x+1, копировать в Лист "НАКЛ" в столбец А(х)
Если I35 = 0, то перейти на I(31+48), иначе, x=x+1, копировать в Лист "НАКЛ" в столбец А(х)
Если I36 = 0, то перейти на I(31+48), иначе, x=x+1, копировать в Лист "НАКЛ" в столбец А(х)

для 2-го дня

Если I79 = 0, то перейти на I(79+48), иначе, x=x+1, копировать в Лист "НАКЛ" в столбец А(х)
Если I80 = 0, то перейти на I(79+48), иначе, x=x+1, копировать в Лист "НАКЛ" в столбец А(х)
Если I81 = 0, то перейти на I(79+48), иначе, x=x+1, копировать в Лист "НАКЛ" в столбец А(х)
Если I82 = 0, то перейти на I(79+48), иначе, x=x+1, копировать в Лист "НАКЛ" в столбец А(х)
Если I83 = 0, то перейти на I(79+48), иначе, x=x+1, копировать в Лист "НАКЛ" в столбец А(х)
Если I84 = 0, то перейти на I(79+48), иначе, x=x+1, копировать в Лист "НАКЛ" в столбец А(х)
------------------------------------------------------------------------------------------
для 31-го дня

Если I1471 = 0, то конец макроса, иначе, x=x+1, копировать в Лист "НАКЛ" в столбец А(х)
Если I1471 = 0, то конец макроса, иначе, x=x+1, копировать в Лист "НАКЛ" в столбец А(х)
Если I1471 = 0, то конец макроса, иначе, x=x+1, копировать в Лист "НАКЛ" в столбец А(х)
Если I1471 = 0, то конец макроса, иначе, x=x+1, копировать в Лист "НАКЛ" в столбец А(х)
Если I1471 = 0, то конец макроса, иначе, x=x+1, копировать в Лист "НАКЛ" в столбец А(х)
Если I1471 = 0, то конец макроса, иначе, x=x+1, копировать в Лист "НАКЛ" в столбец А(х)
конец макроса

[VictorM]

Да уж, видимо Вас это сильно достало :-)
Хорошо, в таком случае вопрос:

всегда, ввод № -ра, будет начинается с первой строки и подряд

куда ввод номера?
на лист НАКЛ ?

[valerij]

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

Да уж, видимо Вас это сильно достало :-)
Хорошо, в таком случае вопрос:
куда ввод номера?
на лист НАКЛ ?

Гложет, а не умею, а хочется попробовать
Нет, на Лист ЛЕН.......Ц-31

Забыл дописать в алгоритме

Есть книга в ней 13 листов, имена не важно, 14 лист и именем НАКЛ, так из 13 листов с диапазонов 31-36......., скопировать данные в Лист НАКЛ

[VictorM]

Гложет, а не умею, а хочется попробовать

Почитайте вот это. Ваш алгоритм решается в цикле , а здесь нормально все написано.
Управляющие структуры VBA ... Циклы

[VictorM]

Вот примерно так может выглядеть Ваш алгоритм для одного листа.

Sub Алгоритм()
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Goto Reference:=Worksheets("Лен").Range("I31")
For i = 1 To 31
    For u = 1 To 5
    nakl = ActiveCell.Value
        If nakl <> "" Then ActiveCell.Copy Destination:=Worksheets("НАКЛ").Range("A65536").End(xlUp).Offset(1, 0)
    ActiveCell.Offset(1, 0).Activate
    Next u
ActiveCell.Offset(43, 0).Activate
Next i
    .EnableEvents = True
    .ScreenUpdating = True
End With
End Sub

работать должен намного быстрее того, что я Вам предложил ранее. За счет того, что здесь нет лишней активации Листа "НАКЛ" и не нужно удалять пустые ячейки в силу того, что их там попросту не будет.

[valerij]

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

не нужно удалять пустые ячейки в силу того, что их там попросту не будет.

Чето не пашет, нет копий

[VictorM]

Чето не пашет, нет копий

а вот это уж не знаю. У меня все работает "на раз". Ща сделаю для всех листов.

[valerij]

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

У меня все работает

Сори, сори, работает, то я вставил не в листЛЕН, а в отдельный модуль, но опять, идет копирование, с форматом.

[VictorM]

вставил не в листЛЕН, а в отдельный модуль, но опять, идет копирование, с форматом.

так оно и должно работать из модуля. Откажитесь Вы от этих кнопок, используйте для этих целей "надпись" или "автофигуру" проще и гибче. А при отладке макрос вообще запускается из редактора.
А формат - так ведь это ж только алгоритм, набросок. Что ж Вы хотите?

[VictorM]

Вот код для всех листов. Собирает №№накладных в лист НАКЛ.
Работает - что-то около секунды.

Sub НаклСобрать()
iListNames = Array("ЛЕН", "КИЕВ", "ДЕНИС", "УТ-1", "УТ-2", "РЫН", "ПЕН", "КОТ", "РОВ", _
"ТАБ", "С-Ф", "С-З", "Ц-31")
With Application
    .ScreenUpdating = False
    .EnableEvents = False
Worksheets("НАКЛ").Range("A2:A3000").ClearContents
For Each iList In Worksheets(iListNames)
    .Goto Reference:=Worksheets(iList.Index).Range("I31")
 For i = 1 To 31
    For u = 1 To 5
    nakl = ActiveCell.Value
        If nakl <> "" Then ActiveCell.Copy Destination:=Worksheets("НАКЛ").Range("A65536").End(xlUp).Offset(1, 0)
    ActiveCell.Offset(1, 0).Activate
    Next u
    ActiveCell.Offset(43, 0).Activate
 Next i
Next
Worksheets("НАКЛ").Range("A2:A3000").Interior.ColorIndex = xlNone
    .EnableEvents = True
    .ScreenUpdating = True
End With
End Sub