Здравствуйте. Подскажите пожалуйста, как автоматически копировать строки из первого листа на новый (включая столбцы A-I), если в столбце J истина. Можно ли это сделать с помощью встроенных функций, или нужен макрос? заранее спасибо
Здравствуйте. Подскажите пожалуйста, как автоматически копировать строки из первого листа на новый (включая столбцы A-I), если в столбце J истина. Можно ли это сделать с помощью встроенных функций, или нужен макрос? заранее спасибо Ольга93
Сообщение отредактировал Ольга93 - Четверг, 25.04.2013, 23:14
Предполагаю, вы не смогли найти правила форума. Рекомендации по составлению примера из правил.
- Обычно, чтобы понять и помочь - достаточно таблицы на 10-20 строк. - Но при этом старайтесь сохранить структуру, расположение таблиц, имена листов - аналогично оригиналу. - Если файл содержит конфиденциальную информацию - просто замените Ваши данные на нейтральные.
- Максимальный размер файла ограничен размером в 100 Кб.
Предполагаю, вы не смогли найти правила форума. Рекомендации по составлению примера из правил.
- Обычно, чтобы понять и помочь - достаточно таблицы на 10-20 строк. - Но при этом старайтесь сохранить структуру, расположение таблиц, имена листов - аналогично оригиналу. - Если файл содержит конфиденциальную информацию - просто замените Ваши данные на нейтральные.
- Максимальный размер файла ограничен размером в 100 Кб.
Можно отфильтровать по ИСТИНЕ в столбце J. Потом выделяем нужный диапазон, жмем F5, Выделить, Только видимые ячейки, ОК. Копируем, переходим на Лист1, вставляем. Убираем автофильтр. Записал макрорекордером, немного подкорректировал и вот, что получилось: [vba]
Код
Sub Макрос1() Application.ScreenUpdating = False Dim LastRow As Long LastRow = Cells(Rows.Count, 10).End(xlUp).Row Range("$A$2:$J$" & LastRow).AutoFilter Field:=10, Criteria1:="ИСТИНА" Range("A1:I" & LastRow).SpecialCells(xlCellTypeVisible).Copy Sheets("Лист1").[a1] Range("A2:J" & LastRow).AutoFilter Application.ScreenUpdating = True End Sub
[/vba]
Можно отфильтровать по ИСТИНЕ в столбце J. Потом выделяем нужный диапазон, жмем F5, Выделить, Только видимые ячейки, ОК. Копируем, переходим на Лист1, вставляем. Убираем автофильтр. Записал макрорекордером, немного подкорректировал и вот, что получилось: [vba]
Код
Sub Макрос1() Application.ScreenUpdating = False Dim LastRow As Long LastRow = Cells(Rows.Count, 10).End(xlUp).Row Range("$A$2:$J$" & LastRow).AutoFilter Field:=10, Criteria1:="ИСТИНА" Range("A1:I" & LastRow).SpecialCells(xlCellTypeVisible).Copy Sheets("Лист1").[a1] Range("A2:J" & LastRow).AutoFilter Application.ScreenUpdating = True End Sub
Sub Macros() Dim Arr, MyArr() Dim i As Long, j As Long, n As Long With Sheets("НИР_20_15") Arr = .Range(.Range("A3"), .Range("J" & Rows.Count).End(xlUp)) End With For i = 1 To UBound(Arr) If Arr(i, 10) Then ReDim Preserve MyArr(1 To 9, 0 To n) For j = 1 To 9 MyArr(j, n) = Arr(i, j) Next j n = n + 1 End If Next i Sheets("Лист1").Range("A3").Resize(n, 9) = Application.Transpose(MyArr) End Sub
[/vba]
Еще вариант макроса
[vba]
Код
Sub Macros() Dim Arr, MyArr() Dim i As Long, j As Long, n As Long With Sheets("НИР_20_15") Arr = .Range(.Range("A3"), .Range("J" & Rows.Count).End(xlUp)) End With For i = 1 To UBound(Arr) If Arr(i, 10) Then ReDim Preserve MyArr(1 To 9, 0 To n) For j = 1 To 9 MyArr(j, n) = Arr(i, j) Next j n = n + 1 End If Next i Sheets("Лист1").Range("A3").Resize(n, 9) = Application.Transpose(MyArr) End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
