Здравствуйте, имеется макрос по переносу, нужно настроить перенос так, что бы он связывал дату на листе "заказы" с датой "=Сегодня()" на маршрутном листе (там стоит 5-е июля). иными словами, что бы перенос был по двум условиям - это дата отгрузки, и имя водителя. Действие ежедневного характера, это очень упростило бы мне работу. прошу подмоги.
Код |
---|
Sub Перенос() Dim c As Range Dim lr1 As Long, lr2 As Long Dim a() lr1 = Cells(Rows.Count, 2).End(xlUp).Row 'находим номер последней строки на листе орк With Sheets("Маршрутные листы.") 'с листом "Маршрутные листы." lr2 = .Cells(Rows.Count, 4).End(xlUp).Row + 1 'находим номер последней строки на листе "Маршрутные листы." + 1 .Cells(lr2, 5) = Date 'ставим дату разделитель lr2 = lr2 + 1 'увеличиваем номер строки For Each c In Range("B2:B" & lr1) 'для всех ячеек в диапазоне ... If c.Interior.ColorIndex = RGB(191, 191, 191) Then 'если заливка серый то a = Range("B" & c.Row & ":H" & c.Row) 'вносим в массив диапазон .Cells(lr2, 1).Resize(1, 7) = a 'копируем строку на лист "Маршрутный лист." .Cells(lr2, 8) = Date 'ставим дату в последнюю колонку lr2 = lr2 + 1 'увеличиваем номер строки End If Next End With For i = lr To 3 Step -1 'от последней строки до 3й с шагом -1 If Cells(i, 2).Interior.ColorIndex = RGB(191, 191, 191) Then 'если заливка серый то Rows(i).Delete 'строку удаляем End If Next 'Call Сортировка End Sub |