Добрый день! Задачка следующая: Необходимо сделать так, чтобы макрос искал значение ячейки в столбце с определенным названием (пример приложил), при нахождении любого значения в ячейке столбца, копировал эту строку на конкретный лист с аналогичным названием. В примере более понятно изложена суть задачи. Еще если возможно это реализовать, хотелось бы чтобы те строки которые были скопированы с листа "Исходник" закрашивались цветом (так скажем для проверки). Буду премного благодарен, так как голову сломал как это сделать, VBA только начал изучать, а задача приоритетная, для ускорения рабочего процесса.
Добрый день! Задачка следующая: Необходимо сделать так, чтобы макрос искал значение ячейки в столбце с определенным названием (пример приложил), при нахождении любого значения в ячейке столбца, копировал эту строку на конкретный лист с аналогичным названием. В примере более понятно изложена суть задачи. Еще если возможно это реализовать, хотелось бы чтобы те строки которые были скопированы с листа "Исходник" закрашивались цветом (так скажем для проверки). Буду премного благодарен, так как голову сломал как это сделать, VBA только начал изучать, а задача приоритетная, для ускорения рабочего процесса.Tarassov_Egor
Sub ertert112() Dim arr, i& arr = Array("Новейшая", 4, "Новая", 5, "Завышение %", 6, "ПУстые ячейки", 10) Application.ScreenUpdating = False With Sheets("Исходник").Range("A1").CurrentRegion .Parent.AutoFilterMode = False For i = 0 To UBound(arr) Step 2 Sheets(arr(i)).Range("A1").CurrentRegion.Clear .AutoFilter arr(i + 1), "<>" .Copy Sheets(arr(i)).Range("A1") With .CurrentRegion .Offset(1).Resize(.Rows.Count - 1).Interior.ColorIndex = 43 End With .AutoFilter Next i End With Application.ScreenUpdating = True End Sub
Sub ertert112() Dim arr, i& arr = Array("Новейшая", 4, "Новая", 5, "Завышение %", 6, "ПУстые ячейки", 10) Application.ScreenUpdating = False With Sheets("Исходник").Range("A1").CurrentRegion .Parent.AutoFilterMode = False For i = 0 To UBound(arr) Step 2 Sheets(arr(i)).Range("A1").CurrentRegion.Clear .AutoFilter arr(i + 1), "<>" .Copy Sheets(arr(i)).Range("A1") With .CurrentRegion .Offset(1).Resize(.Rows.Count - 1).Interior.ColorIndex = 43 End With .AutoFilter Next i End With Application.ScreenUpdating = True End Sub