Помогите пожалуйста. Есть 20 листов с информацией, нужно что бы при вводе новой информации в любой лист, она(инфо) автоматически копировалась на 21 лист с учетом фильтрации по дате. 21 лист что был сборником всей инфы с 20 листов. Вся инфо представлена в виде одной строки и 7 ячеек.
Помогите пожалуйста. Есть 20 листов с информацией, нужно что бы при вводе новой информации в любой лист, она(инфо) автоматически копировалась на 21 лист с учетом фильтрации по дате. 21 лист что был сборником всей инфы с 20 листов. Вся инфо представлена в виде одной строки и 7 ячеек.serega26
Проверьте такой вариант. Таблица формируется макросом при активации листа 21. В коде написала, что надо исправить при внедрении макроса в реальный файл с 21-м листом Сделала более универсальный вариант. Файл перевложила
Проверьте такой вариант. Таблица формируется макросом при активации листа 21. В коде написала, что надо исправить при внедрении макроса в реальный файл с 21-м листом Сделала более универсальный вариант. Файл перевложилаPelena
Все получилось. Все так. Только вопрос такой, а как сделать так что бы макрос считал данные только с этих 21 листов?что бы с других листов не считал инфо.
Все получилось. Все так. Только вопрос такой, а как сделать так что бы макрос считал данные только с этих 21 листов?что бы с других листов не считал инфо.serega26
Public Sub Worksheet_Activate() Dim rng As Range, i&, lrow& Application.ScreenUpdating = False Set rng = ActiveSheet.UsedRange rng.Offset(1).Resize(rng.Rows.Count - 1).ClearContents For i = 1 To 20 lrow = Sheets(21).Cells(Rows.Count, 1).End(xlUp).Row + 1 With Sheets(i) .Range("A2:H" & .Cells(Rows.Count, 1).End(xlUp).Row).Copy Sheets(21).Range("A" & lrow) End With Next i With Sheets(21) lrow = .Cells(Rows.Count, 1).End(xlUp).Row .Range("A1").Select With .Sort .SortFields.Clear .SortFields.Add Key:=Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers .SetRange Range("A2:H" & lrow) .Header = xlNo .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End With Application.ScreenUpdating = True End Sub
[/vba]
Тогда так попробуйте [vba]
Код
Public Sub Worksheet_Activate() Dim rng As Range, i&, lrow& Application.ScreenUpdating = False Set rng = ActiveSheet.UsedRange rng.Offset(1).Resize(rng.Rows.Count - 1).ClearContents For i = 1 To 20 lrow = Sheets(21).Cells(Rows.Count, 1).End(xlUp).Row + 1 With Sheets(i) .Range("A2:H" & .Cells(Rows.Count, 1).End(xlUp).Row).Copy Sheets(21).Range("A" & lrow) End With Next i With Sheets(21) lrow = .Cells(Rows.Count, 1).End(xlUp).Row .Range("A1").Select With .Sort .SortFields.Clear .SortFields.Add Key:=Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers .SetRange Range("A2:H" & lrow) .Header = xlNo .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End With Application.ScreenUpdating = True End Sub
У меня же нет Вашего файла с 20-ю листами. Правой кнопкой мыши по ярлыку 21-го листа -- Исходный текст -- скопируйте в открывшееся окно текст макроса из предыдущего сообщения
У меня же нет Вашего файла с 20-ю листами. Правой кнопкой мыши по ярлыку 21-го листа -- Исходный текст -- скопируйте в открывшееся окно текст макроса из предыдущего сообщенияPelena
"Черт возьми, Холмс! Но как??!!" Ю-money 41001765434816
Дальше при переходе на 21 лист должна сформироваться таблица. Для произвольного количества столбцов [vba]
Код
Public Sub Worksheet_Activate() Dim rng As Range, i&, lrow&, lcol& Application.ScreenUpdating = False Set rng = ActiveSheet.UsedRange rng.Offset(1).Resize(rng.Rows.Count - 1).ClearContents lcol = Sheets(21).Cells(1, Columns.Count).End(xlToLeft).Column For i = 1 To 20 lrow = Sheets(21).Cells(Rows.Count, 1).End(xlUp).Row + 1 With Sheets(i) .Range("A2").Resize(.Cells(Rows.Count, 1).End(xlUp).Row - 1, lcol).Copy Sheets(21).Range("A" & lrow) End With Next i With Sheets(21) lrow = .Cells(Rows.Count, 1).End(xlUp).Row .Range("A1").Select With .Sort .SortFields.Clear .SortFields.Add Key:=Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers .SetRange Range("A2").Resize(lrow, lcol) .Header = xlNo .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End With Application.ScreenUpdating = True End Sub
[/vba]
Дальше при переходе на 21 лист должна сформироваться таблица. Для произвольного количества столбцов [vba]
Код
Public Sub Worksheet_Activate() Dim rng As Range, i&, lrow&, lcol& Application.ScreenUpdating = False Set rng = ActiveSheet.UsedRange rng.Offset(1).Resize(rng.Rows.Count - 1).ClearContents lcol = Sheets(21).Cells(1, Columns.Count).End(xlToLeft).Column For i = 1 To 20 lrow = Sheets(21).Cells(Rows.Count, 1).End(xlUp).Row + 1 With Sheets(i) .Range("A2").Resize(.Cells(Rows.Count, 1).End(xlUp).Row - 1, lcol).Copy Sheets(21).Range("A" & lrow) End With Next i With Sheets(21) lrow = .Cells(Rows.Count, 1).End(xlUp).Row .Range("A1").Select With .Sort .SortFields.Clear .SortFields.Add Key:=Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers .SetRange Range("A2").Resize(lrow, lcol) .Header = xlNo .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End With Application.ScreenUpdating = True End Sub
Вы не знаете, как сохраняется файл? Если файл, как в примере, в формате xls, то просто нажмите кнопку Сохранить. Если в более новом формате, то Файл -- Сохранить как -- в поле Тип файла выберите Файл с поддержкой макросов .xlsm -- Сохранить
Вы не знаете, как сохраняется файл? Если файл, как в примере, в формате xls, то просто нажмите кнопку Сохранить. Если в более новом формате, то Файл -- Сохранить как -- в поле Тип файла выберите Файл с поддержкой макросов .xlsm -- СохранитьPelena
"Черт возьми, Холмс! Но как??!!" Ю-money 41001765434816
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
