Здравствуйте, имеется макрос по переносу, нужно настроить перенос так, что бы он связывал дату на листе "заказы" с датой "=Сегодня()" на маршрутном листе (там стоит 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
|
