Oh_Nick, проблема в том, что слово "переносится" можно понимать по разному. Для одних это - скопировать и вставить, для других - вырезать и вставить. Посмотрите вариант с копированием, при необходимости замену копирования на вырезание доделаете сами. В модули листов Export, Import и Local: [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Dim tr&, r&, n$ tr = Target.Row n = ActiveSheet.Name If Target.Cells.Count > 1 Then Exit Sub If Not Intersect(Target, Range(tr & ":" & tr)) Is Nothing Then On Error GoTo Er1 tr = Range(tr & ":" & tr).Find(What:="Не нужно").Row Rows(tr).Copy Sheets("CLOSED " & n).Select r = Sheets("CLOSED " & n).UsedRange.Rows.Count Sheets("CLOSED " & n).Rows(r + 1).Select ActiveSheet.Paste Sheets(n).Select Application.CutCopyMode = False End If Exit Sub Er1: End Sub
[/vba]
Oh_Nick, проблема в том, что слово "переносится" можно понимать по разному. Для одних это - скопировать и вставить, для других - вырезать и вставить. Посмотрите вариант с копированием, при необходимости замену копирования на вырезание доделаете сами. В модули листов Export, Import и Local: [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Dim tr&, r&, n$ tr = Target.Row n = ActiveSheet.Name If Target.Cells.Count > 1 Then Exit Sub If Not Intersect(Target, Range(tr & ":" & tr)) Is Nothing Then On Error GoTo Er1 tr = Range(tr & ":" & tr).Find(What:="Не нужно").Row Rows(tr).Copy Sheets("CLOSED " & n).Select r = Sheets("CLOSED " & n).UsedRange.Rows.Count Sheets("CLOSED " & n).Rows(r + 1).Select ActiveSheet.Paste Sheets(n).Select Application.CutCopyMode = False End If Exit Sub Er1: End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If (Target.Cells.Count > 1) Then Exit Sub On Error GoTo Er1
If ((Target.Value = "Не нужно") And (Target.Column = 34)) Then Rows(Target.Row).Copy ActiveWorkbook.Sheets(4).Rows(ActiveWorkbook.Sheets(4).UsedRange.Rows.Count + 1).Insert Rows(Target.Row).Delete End If
On Error GoTo 0 Er1: Exit Sub End Sub
[/vba]
Привязал к каждому листу и колонке.
_Igor_61, спасибо. Немного модернизировал:
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If (Target.Cells.Count > 1) Then Exit Sub On Error GoTo Er1
If ((Target.Value = "Не нужно") And (Target.Column = 34)) Then Rows(Target.Row).Copy ActiveWorkbook.Sheets(4).Rows(ActiveWorkbook.Sheets(4).UsedRange.Rows.Count + 1).Insert Rows(Target.Row).Delete End If
Поздравляю! Нафига тогда Вы показывали в примере, что "Не нужно" на разных листах находится в разных столбцах и зависимость названия листов между исходными и конечными ("Closed")? Т.е. получается, Вы уже знали, как определить строку в нужном столбце и программные имена листов? Это троллинг такой? Извините за отнятое у Вас время. Не в обиду, просто формулируйте свои задачи конкретней, в т.ч. и в файлах-примерах. И на будущее: пробелы в названиях листов нежелательны.
Поздравляю! Нафига тогда Вы показывали в примере, что "Не нужно" на разных листах находится в разных столбцах и зависимость названия листов между исходными и конечными ("Closed")? Т.е. получается, Вы уже знали, как определить строку в нужном столбце и программные имена листов? Это троллинг такой? Извините за отнятое у Вас время. Не в обиду, просто формулируйте свои задачи конкретней, в т.ч. и в файлах-примерах. И на будущее: пробелы в названиях листов нежелательны._Igor_61
Сообщение отредактировал _Igor_61 - Среда, 03.03.2021, 18:50
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
