Уважаемые участники форума. Возможен ли макрос в данном случае: книга состоит из трёх листов. Первый лист заполняется от руки. Желательно, чтобы при заполнении столбца "фирма" соответствующая строка копировалась на один из двух листов (если фирма ИП, то на лист ИП, если КЕК - то на лист КЕК. Если что-либо другое - копирование не нужно). Столбец с номером в копировании участвовать не должен, так как на каждом листе будет своя формула для создания номера. Копирование должно происходить автоматически (без кнопки), после внесения данных в столбец "Фирма". Не должно быть привязки к конкретному диапазону по высоте столбцов, так как книга заполняется в течение года и количество строк неизвестно. Файл с примером прилагаю. Буду благодарна за любую идею.
Уважаемые участники форума. Возможен ли макрос в данном случае: книга состоит из трёх листов. Первый лист заполняется от руки. Желательно, чтобы при заполнении столбца "фирма" соответствующая строка копировалась на один из двух листов (если фирма ИП, то на лист ИП, если КЕК - то на лист КЕК. Если что-либо другое - копирование не нужно). Столбец с номером в копировании участвовать не должен, так как на каждом листе будет своя формула для создания номера. Копирование должно происходить автоматически (без кнопки), после внесения данных в столбец "Фирма". Не должно быть привязки к конкретному диапазону по высоте столбцов, так как книга заполняется в течение года и количество строк неизвестно. Файл с примером прилагаю. Буду благодарна за любую идею.Pendalfik
Private Sub Worksheet_Change(ByVal Target As Range) Dim R&, RSheet&, ShName$ Dim Rn As Range R = Target.Row Set Rn = Range(Cells(R, 2), Cells(R, 4)) If WorksheetFunction.CountA(Rn) = 3 Then ShName = Cells(R, 4) On Error Resume Next With Sheets(ShName) If Err Then Exit Sub RSheet = .Cells(Rows.Count, 1).End(xlUp).Row + 1 .Cells(RSheet, 1) = Val(.Cells(RSheet - 1, 1)) + 1 Rn.Copy .Cells(RSheet, 2) End With End If Target.Activate End Sub
[/vba]
Перезалил файл
В модуль "Общий лист":
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Dim R&, RSheet&, ShName$ Dim Rn As Range R = Target.Row Set Rn = Range(Cells(R, 2), Cells(R, 4)) If WorksheetFunction.CountA(Rn) = 3 Then ShName = Cells(R, 4) On Error Resume Next With Sheets(ShName) If Err Then Exit Sub RSheet = .Cells(Rows.Count, 1).End(xlUp).Row + 1 .Cells(RSheet, 1) = Val(.Cells(RSheet - 1, 1)) + 1 Rn.Copy .Cells(RSheet, 2) End With End If Target.Activate End Sub
Michael_S, Можно небольшое уточнение. Какие изменения следует внести, чтобы последнюю пустую строку EXcel искал не с первой ячейки (там где номер). Некоторые записи имеют это поле пустым (именно поэтому я писала об игнорировании данного столбца). При исполнении данной процедуры, если ячейка номер пустая, EXcel считает пустой всю строку и просто заменяет в ней запись, а этого быть не должно.
Michael_S, Можно небольшое уточнение. Какие изменения следует внести, чтобы последнюю пустую строку EXcel искал не с первой ячейки (там где номер). Некоторые записи имеют это поле пустым (именно поэтому я писала об игнорировании данного столбца). При исполнении данной процедуры, если ячейка номер пустая, EXcel считает пустой всю строку и просто заменяет в ней запись, а этого быть не должно.Pendalfik
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
