Екцел - Макро за креирање нове радне књиге и копирање података

Питање

Тражим макро за копирање редова на основу садржаја парцијалне ћелије колоне. Имам Екцел таблицу која се зове "арц.клск" из које бих желела да копирам податке у неколико нових екцел фајлова када се испуне одређени критеријуми. Датотека која садржи Екцел је Ц: Документи и подешавања кккк Десктоп. Ја сам само почетник у Екцелу.

Испод је узорак арц.клск

 ГП БР ЦУСТ_НО ЦУСТ_НАМЕ дан мо година И1 01 999999 СМИТХ 00 08 09 И1 аб 999999 СМИТХ 04 08 09 И1 цд 999999 СМИТХ 04 10 09 И1 01 999999 СМИТХ 04 01 10 И1 02 999999 цд 999999 СМИТХ 02 03 10 И1 цд 999999 СМИТХ 04 03 10 И1 цд 999999 СМИТХ 30 07 09 И1 аб 999999 СМИТХ 30 07 09 
  • Желим да макро копира редове који имају 'аб' у колони Б (са насловом БР) и сачувају га у новом екцел фајлу са именом аб.клск у истом директоријуму локације.
  • Исто важи и за 'цд', '01' и '02' тако што чува податке у фајловима са именом цд.клск, 01.клск и тако даље.

Решење

1. Направите копију свог радног листа

2. Отворите радну књигу

3. Притисните АЛТ + Ф11 (истовремено АЛТ и Ф11 тастер). Ово је отворен ВБЕ

4. Из менија ВБЕ, кликните на Инсерт, а затим на Модуле кликом на њега. Ово ће отворити празан модул

5. Копирајте шифру дати након инструкција тако што ћете изабрати код (наћи ћете након инструкција) и притиснути ЦТРЛ + Ц (оба тастера истовремено)

6. Залијепите код у ново додани модул (погледајте корак 4) тако што ћете кликнути на модул и притиснути ЦТРЛ + В (опет обоје истовремено)

7. Уверите се да нема црвене линије у налепљеном коду.

8. Притисните Ф5 да бисте покренули макро.

9 Проверите документе на подразумеваној локацији где генерално Екцел чува датотеку.

ОВДЈЕ ЈЕ КОД

 Суб детаилс () Дим тхисВБ Ас Стринг Дим невВБ Ас Стринг тхисВБ = АцтивеВоркбоок.Наме Он Еррор Настројка следуусих листов ("темпсхеет"). Изаберите Ако је АцтивеСхеет.АутоФилтерМоде затим ћелија. Изаберите На грешци Настави Следећи АцтивеСхеет.СховАллДата на грешци ГоТо 0 Енд Иф Цолумнс ("Б: Б") Изаберите Селецтион.Цопи Схеетс ("темпсхеет") Изаберите Ранге ("А1"). Селецт АцтивеСхеет.Пасте Апплицатион.ЦутЦопиМоде = Фалсе Иф (Ћелије (1, 1) = "") Затим ластров = Ћелије (1, 1). Енд (клДовн) .Ров Ако задња редови.Цоунт Затим Ранге ("А1: А") & ластров - 1) .Селецт Селецтион.Делете Схифт: = клУп Енд Иф Енд Ако су колоне ("А: А"). Одаберите Цолумнс ("А: А"). АдванцедФилтер Ацтион: = клФилтерЦопи, _ ЦопиТоРанге: = Ранге (" Б1 "), Уникуе: = Труе Цолумнс (" А: А ") Делете Целлс.Селецт Селецтион.Сорт _ Кеи1: = Ранге (" А2 "), Ордер1: = клАсцендинг, _ Хеадер: = клИес, ОрдерЦустом: = 1, _ МатцхЦасе: = Фалсе, Оријентација: = клТопТоБоттом, _ ДатаОптион1: = клСортНормал лМакСупп = Ћелије (Ровс.Цоунт, 1). Енд (клУп) .Ров Фор с уппно = 2 За лМакСупп Виндовс (тхисВБ) .Ацтивате супНаме = Схеетс ("темпсхеет"). Ранге ("А" & суппно) Ако је супНаме "" Затим Воркбоок.Адд АцтивеВоркбоок.СавеАс супНаме невВБ = АцтивеВоркбоок. Изаберите ћелије.Изаберите Ако је АцтивеСхеет.АутоФилтерМоде = Фалсе онда Селецтион.АутоФилтер Енд Ако Селецтион.АутоФилтер Фиелд: = 2, Цритериа1: = "=" & супНаме, _ Оператор: = клАнд, Цритериа2: = "" ластров = Целлс (Ровс.Цоунт, 2) .Енд (клУп) .Ров Ровс ("1:" & ластров). Копирај Виндовс (невВБ) .Ацтивате АцтивеСхеет.Пасте АцтивеВоркбоок.Саве АцтивеВоркбоок.Цлосе Енд Иф Нект Схеетс ( "Темпсхеет") Брисање листова ("Схеет1") .Одаберите Ако АцтивеСхеет.АутоФилтерМоде онда Целлс.Селецт АцтивеСхеет.СховАллДата Енд Енд Енд Суб 

Захваљујући Ризвиса1 за овај тип.

Претходни Чланак Sledeći Чланак

Топ Савети