Автоматизировать перенос записанной строки с неким критерием с Листа 1 на Лист 2, 3, 4... К примеру на Листе 1 есть список постоянно добавляющихся затрат с сортировкой по дате, а можно ли чтобы эти же самые затраты, но с присвоенным критерием, к примеру хоз. нужды, ремонт оборудования разделялись на соответствующие отдельные листы соответственно.
Виноват, забыл файл с примером прицепить.
Добрый день!
Автоматизировать перенос записанной строки с неким критерием с Листа 1 на Лист 2, 3, 4... К примеру на Листе 1 есть список постоянно добавляющихся затрат с сортировкой по дате, а можно ли чтобы эти же самые затраты, но с присвоенным критерием, к примеру хоз. нужды, ремонт оборудования разделялись на соответствующие отдельные листы соответственно.
Становитесь на строку в которой находится нужная информация и запускаете макос [vba]
Код
Sub Perenos() Dim Rng As Range, WS As Worksheet, L As Long With ActiveCell: Set Rng = Range("A" & .Row & ":D" & .Row): End With Set WS = Worksheets(Rng.Cells(1, 4).Text) Rng.Resize(1, 3).Copy Destination:=WS.Range("A" & WS.Cells(Rows.Count, 1).End(xlUp).Row + 1) WS.Columns("A:C").EntireColumn.AutoFit End Sub
[/vba] Если несколько раз нажмете на одной и той же строке, она перенесется несколько раз - проверки на дублирование нет. Листы должны называться так же, как и группы затрат (пока у Вас так и есть) UPD добавил автоподбор ширины колонок
Становитесь на строку в которой находится нужная информация и запускаете макос [vba]
Код
Sub Perenos() Dim Rng As Range, WS As Worksheet, L As Long With ActiveCell: Set Rng = Range("A" & .Row & ":D" & .Row): End With Set WS = Worksheets(Rng.Cells(1, 4).Text) Rng.Resize(1, 3).Copy Destination:=WS.Range("A" & WS.Cells(Rows.Count, 1).End(xlUp).Row + 1) WS.Columns("A:C").EntireColumn.AutoFit End Sub
[/vba] Если несколько раз нажмете на одной и той же строке, она перенесется несколько раз - проверки на дублирование нет. Листы должны называться так же, как и группы затрат (пока у Вас так и есть) UPD добавил автоподбор ширины колонокМВТ
Сообщение отредактировал МВТ - Суббота, 11.04.2015, 15:58