Копирование столбцов с созданием таблицы по условиям

Страница 1 из 1 1
Модератор форума: китин, _Boroda_, DrMini

Копирование столбцов с созданием таблицы по условиям (Макросы/Sub)

Maryasha

Дата: Пятница, 20.10.2017, 12:20 | Сообщение № 1

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 152

Репутация: 0 ±

Замечаний: 0% ±

Excel 2013

Добрый день!
Подскажите как создать макрос для копирования ряда столбцов из большой исходной таблицы по двум условиям - определенный сотрудник и определенный холдинг, при выборе этих 2ух параметров копируются указанные столбцы только по ним, по сути макрос заменяет 2 фильтра и скрытие части столбцов, образец прилагаю, заранее всем спасибо!

К сообщению приложен файл: 2144306.xlsx (14.0 Kb)

Ответить

_Boroda_

Дата: Пятница, 20.10.2017, 12:50 | Сообщение № 2

Группа: Админы

Ранг: Местный житель

Сообщений: 17006

Репутация: 6667 ±

Замечаний: ±

2003; 2007; 2010; 2013 RUS

Так нужно?
[vba]

Код

Sub tt()
Sheets("Исходная таблица").Columns("A:U").AdvancedFilter Action:=xlFilterCopy _
, CriteriaRange:=Range("N1:O2"), CopyToRange:=Range("A1:L1"), Unique:=False
End Sub

[/vba]

К сообщению приложен файл: 2144306_2.xlsm (23.4 Kb)

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995

Ответить

китин

Дата: Пятница, 20.10.2017, 13:21 | Сообщение № 3

Группа: Модераторы

Ранг: Экселист

Сообщений: 7040

Репутация: 1080 ±

Замечаний: 0% ±

Excel 2007;2010;2016

И вам доброго!!! кнопочка на Лист2
код
[vba]

Код

Sub TTT()
Dim t_&, t2_&
t_ = Sheets("Исходная таблица").Cells(Rows.Count, 1).End(xlUp).Row
t2_ = Sheets("Лист2").Cells(Rows.Count, 1).End(xlUp).Row
   D1 = Sheets("Лист2").Range("S4").Value
   D2 = Sheets("Лист2").Range("T4").Value
        Sheets("Исходная таблица").Range("$A$1:$U$" & t_).AutoFilter Field:=1, Criteria1:= _
        D1
        Sheets("Исходная таблица").Range("$A$1:$U$" & t_).AutoFilter Field:=5, Criteria1:= _
        D2
            With Sheets("Исходная таблица")
              .Columns("C:D").EntireColumn.Hidden = True
              .Columns("F:H").EntireColumn.Hidden = True
              .Columns("J:L").EntireColumn.Hidden = True
              .Columns("O:O").EntireColumn.Hidden = True

            End With
        Sheets("Лист2").Range("A2:L" & t2_ + 1).ClearContents
        Sheets("Исходная таблица").Range("A2:U" & t_).SpecialCells(xlCellTypeVisible).Copy
        Sheets("Лист2").Range("A2").PasteSpecial
    Sheets("Исходная таблица").Columns("A:U").EntireColumn.Hidden = False
    Sheets("Исходная таблица").Range("$A$1:$U$" & t_).AutoFilter Field:=5
    Sheets("Исходная таблица").Range("$A$1:$U$" & t_).AutoFilter Field:=1

End Sub

[/vba]

К сообщению приложен файл: _2144306-2.xlsm (24.1 Kb)

Не судите очень строго:я пытаюсь научиться
ЯД 41001877306852

Ответить

Maryasha

Дата: Пятница, 20.10.2017, 14:16 | Сообщение № 4

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 152

Репутация: 0 ±

Замечаний: 0% ±

Excel 2013

_Boroda_, спасибо большое, все работает
P.S. Ваш форум все больше напоминает мне выручай-комнату =)

Ответить

Копирование столбцов с созданием таблицы по условиям (Макросы/Sub)

Страница 1 из 1
1