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

[valerij]

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

Вот код для всех листов.

Вот это другое дело, а вот макрос который Все данные, за 31 день, делает за доли секунд, только я не знаю, как правильно его запустить!!
VictorM
Попробуй!!!

'*************************************************************************************'
'          Дата создания 27/05/2008г.                                                 '
'          Автор Pashulka, в миру Павел                                               '
'          E-Mail   Pashulka@nm.ru                                                       '
'*************************************************************************************'

Private Sub CreateList()
    iOffset& = 2
    With Application
         .ScreenUpdating = False
         .EnableEvents = False
         .Calculation = xlManual
         Dim iSource As Range
         For iCount& = 1 To ThisWorkbook.Worksheets.Count - 1
             With ThisWorkbook.Worksheets(iCount&)
                  Set iSource = Union(.[I31:I36], .[I31:I36])
                  For iRow& = 79 To 1471 Step 48
                      Set iSource = Union(iSource, .Cells(iRow&, "I").Resize(6))
                  Next
                  Set iSource = _
                  iSource.SpecialCells(xlCellTypeConstants, xlNumbers)
                  iSource.Copy: Me.Cells(iOffset, "A").PasteSpecial xlValues
                  iOffset& = iOffset& + iSource.Count
             End With
         Next
         .Calculation = xlAutomatic
         .EnableEvents = True
         .ScreenUpdating = True
    End With
End Sub

' Предполагается, что :
'
' 1. диапазон, числовые данные которого нам необходимо скопировать, постоянен
' 2. он обязательно содержит хотя бы одно числовое значение, _
     которое не является результатом вычислений формулы
' 3. обрабатываемые рабочие листы не защищены
' 4. рабочий лист с общими данными является последним
' 5. столбец "A" не защищён
'
' P.S. Естественно, что перед созданием нового списка,
'      столбец "A" желательно очистить от старых данных.

Private Sub CommandButton1_Click()
    Application.Run Macro:="CompData"
End Sub

[VictorM]

Полный код, заменяющий макрос ВыбратьНакладные
Все данные за 31 день собирает за доли секунды. Замените им существующий.

Sub НаклСобрать()
iListNames = Array("ЛЕН", "КИЕВ", "ДЕНИС", "УТ-1", "УТ-2", "РЫН", "ПЕН", "КОТ", "РОВ", _
"ТАБ", "С-Ф", "С-З", "Ц-31")
With Application
    .ScreenUpdating = False
    .EnableEvents = False
Worksheets("НАКЛ").Range("A2:A3000").ClearContents
For Each iList In Worksheets(iListNames)
    'суммируем отрицательные значения в ячейку I1500
    .Goto Reference:=Worksheets(iList.Index).Range("I38")
        zSum = 0
            For i = 1 To 30
                iSum = ActiveCell.Value
                If iSum < 0 Then zSum = zSum + iSum
                ActiveCell.Offset(48, 0).Activate
            Next i
            Range("I1500").Value = zSum
    'собираем все номера накладных на лист НАКЛ
    .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

с кодом от Pashulka надо разобраться сначала.

[VictorM]

не знаю, в чем тут дело
замените в макросе Pashulka слово Ме на Worksheets("НАКЛ"). Все будет работать.
А запускать можно так

Private Sub CommandButton1_Click()
    Call CreateList
End Sub

[valerij]

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

не знаю, в чем тут дело

то же самое и я спросил, вот его ответ, может ты поймешь!

Подробно об'яснять причину, поверьте, нет времени, но могу в качестве компенсации предложить три варианта решения :
--------------------------------------------------------------------------------


CreateList

Call CreateList

Application.Run Macro:=Me.CodeName & ".CreateList" 'Run Me.CodeName & ".CreateList"

[VictorM]

Эти ответы касаются способов запуска макроса CreateList, Call CreateList и т.д. Я же Вам уже написал как его запустить
Private Sub CommandButton1_Click()
Call CreateList
End Sub
а моя фраза касалась слова Ме в строке
iSource.Copy: Me.Cells(iOffset, "A").PasteSpecial xlValues
что, собственно, неважно. Все решается строкой
iSource.Copy: Worksheets("НАКЛ").Cells(iOffset, "A").PasteSpecial xlValues
и все прекрасно работает.

[valerij]

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

способов запуска макроса .

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

[VictorM]

В модуль и не обязательтно в отдельный. Вставьте в любой существующий.

[valerij]

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

В модуль и не обязательтно в отдельный. Вставьте в любой существующий.

Щас попробую

[valerij]

Все, разобрался.
Все работает.
Иду спать, завтра(уже сегодня) на очереди еще один, супер макрос