Автоматическое копирование строки по выполнению условия

[staniiislav]

Если будут не смежные, тогда примерно так будет выглядеть код (немного переделан):

Sub КопированиеЕслиБольшеИлиРавно()
'Объявляем переменные
Dim Wb As Workbook, r As Long, r2 As Long, lt As String, lt2 As String
'Сообщение о предложении делать копирование или нет
If MsgBox("Скопировать строки, которые меньше/или равны [критическому значению]?", vbYesNo, "Подтверждение") <> vbYes Then Exit Sub
'Отключение обновления экрана
Application.ScreenUpdating = False
'Отключение обработки событий
Application.EnableEvents = False
'Объявляем переменной Wb имя текущей книги
Set Wb = ActiveWorkbook
'Объявляем переменной lt2 имя текущего листа
lt2 = ActiveSheet.Name
'Объявляем переменной lt имя листа "Лист2"
lt = "Лист2"
'В текущей книги, на текущем листе автофильтром выбираем значения по выделеные красным цветом по столбцу F
Wb.Sheets(lt2).Range("$F$1:$F$10000").AutoFilter Field:=1, Criteria1:=RGB(255, 199, 206), Operator:=xlFilterCellColor
'Ищим последнию заполненную ячейку по столбцу С, и присваем переменной r номер строки, найденного последнего значения
r = Cells(Rows.Count, "C").End(xlUp).Offset(, 0).Row
'Ищим последнию заполненную ячейку по столбцу С на листе "Лист2", и присваем переменной r2 номер строки, найденного последнего значения, и добавляем еще одну строку
r2 = Wb.Sheets(lt).Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).Row
'В текущей книги, на текущем листе копируем значения начиная с А3 и заканчивая Е(будет стоять число полученое переменной r)
Wb.Sheets(lt2).Range("A3:B" & r).Copy
Wb.Sheets(lt).Range("A" & r2).PasteSpecial Paste:=xlPasteValues
Wb.Sheets(lt2).Range("D3:E" & r).Copy
Wb.Sheets(lt).Range("D" & r2).PasteSpecial Paste:=xlPasteValues
'Сбрасываем выделения, после копирования [этой строки раньше небыло, добавьте]
Application.CutCopyMode = False
'Включаем обработку событий
Application.EnableEvents = True
'Включаем обновление экрана
Application.ScreenUpdating = True
End Sub

красным выделено, что переделано

[Mr.Vahe]

Спасибо!!! Пока все предельно ясно))