Vba excel копирование на один лист

AcademiC

Пользователь

Сообщений: 43
Регистрация: 01.01.1970

Уважаемые форумчане, я заранее знаю, что вопрос обозначенный в теме, задавался уже не один десяток раз… и обсуждался уже пару сотен раз… НО, я честно прочитал множество веток… я второй день не отрывая задницу от стула и обнявшись с книжкой Уокенбаха пытаюсь решить эту, для многих, видимо, тривиальную задачу… я сдаюсь, я не понимаю КАК? Логика формул Excel в VBA не работает, ну т.е. работает но не зеркально… если бы можно было решить эту задачу не прибегая к VBA — я бы решил… но, тут нужен VBA, а силы мои кончились…  

  И хотя постановка задачи тривиальна, но все же:  
* Есть книга *.xlsm (во вложении);  
* Есть несколько вкладок (отмечены цветом): «Гор», «Каш», «Вол», «Нау»;  
* С каждой из этих вкладок нужно скопировать данные в лист «Лист2» — в данном листе уже заполнена «шапка» — задача скопировать только данные из вышеупомянутых листов;  
* Условие копирования — начиная с первой строки (Строка 3), до последней заполненной (определение последней заполненной строки с горем пополам смог решить — читай найти решение на форуме): Sub CopyManagers5() в модуле Copy в прилагаемом файле;  
* но я не понимаю КАК? реализовать следующее:    
а) диапазон для копирования я выделил, но если я, запуская макрос, нахожусь не на том листе для которого этот макрос написан (в примере макрос для листа «Вол», т.е. иначе говоря лист «Вол» неактивен) — вылетает ошибка…    
б) проблема номер два — ну получилось у меня скопировать данные на лист «Лист2», как заставить макрос перейти на следующий, необходимый мне, лист для выделения и копирования следующего блока данных (перечень листов откуда копировать данные — заранее известен)?    
в) Проблема три: как на этом листе «Лист2» вставить следующий блок данных в след за тем блоком, которые был перенесен с во время первой итерации (чтобы данные копировались на «Лист2» друг за другом)?    
г) Проблема четыре — допустим произошло чудо, все скопировалось как надо на лист «Лист2», как заставить макрос при следующем запуске стереть с этого листа («Лист2») все данные кроме шапки (предполагается, что упомянутые вкладки будут редактироваться ежедневно)?  

  Пожалуйста, помогите.  

  P.S. Архив разбит на 2 части.

AcademiC

Пользователь

Сообщений: 43
Регистрация: 01.01.1970

Вторая часть файла (архив)

Hugo

Пользователь

Сообщений: 23251
Регистрация: 22.12.2012

б) for each sh in arr  
arr — это массив «перечень листов откуда копировать данные — заранее известен»  
Значение sh подставляем в конструкцию sheets(sh) — будь то индекс или имя.  
в) Вы ведь сказали «определение последней заполненной строки с горем пополам смог решить» — вот и определяйте и копируйте ниже.  
г) аналогично — определяйте и стирайте, или удаляйте строки целиком.  

  Файлы не смотрел.

AcademiC

Пользователь

Сообщений: 43
Регистрация: 01.01.1970

б) Я правильно понимаю логику?  
Dim arr As Range  
Set arr = Worksheets(«Вол», «Гор», «Каш», «Нау»)  

  …а sh какой тип определить?

Hugo

Пользователь

Сообщений: 23251
Регистрация: 22.12.2012

Вот, вполне человеческая логика  

    Sub tt()  
   Dim arr  
   Application.ScreenUpdating = False  
   arr = Split(«Ćīš Źąų Āīė Ķąó»)  
   Sheets(«Ėčńņ2»).Range([AZ3], Range(«A» & Rows.Count).End(xlUp)).ClearContents
   For Each sh In arr  
       With Sheets(sh)  
           .Range(.[AZ3], .Range(«A» & .Rows.Count).End(xlUp)).Copy Sheets(«Ėčńņ2»).Range(«A» & Rows.Count).End(xlUp).Offset(1)
       End With  
   Next  
   Application.ScreenUpdating = True  
End Sub  

    Остаются вопрос — а не надо ли «убивать» формулы?

Hugo

Пользователь

Сообщений: 23251
Регистрация: 22.12.2012

Извините, не уследил…  

    Sub tt()  
   Dim arr  
   Application.ScreenUpdating = False  
   arr = Split(«Гор Каш Вол Нау»)  
   Sheets(«Лист2»).Range([AZ3], Range(«A» & Rows.Count).End(xlUp)).ClearContents
   For Each sh In arr  
       With Sheets(sh)  
           .Range(.[AZ3], .Range(«A» & .Rows.Count).End(xlUp)).Copy Sheets(«Лист2»).Range(«A» & Rows.Count).End(xlUp).Offset(1)
       End With  
   Next  
   Application.ScreenUpdating = True  
End Sub

Hugo

Пользователь

Сообщений: 23251
Регистрация: 22.12.2012

Справедливо, сам сколько раз поправлял  

       With Sheets(«Лист2»)  
   .Range(.[AZ3], .Range(«A» & .Rows.Count).End(xlUp)).ClearContents
   End With

Юрий М

Модератор

Сообщений: 60575
Регистрация: 14.09.2012

Контакты см. в профиле

AcademiC, так дело не пойдёт: Вы полагаете, что, если нельзя 500К, то можно пять по 100? Не верю, что для решения Вашего вопроса нельзя создать небольшой файл-пример.

Hugo

Пользователь

Сообщений: 23251
Регистрация: 22.12.2012

Т.е. вот так с «ловлей блох» (ещё одну точку добавил):  

    Sub tt()  
   Dim arr  
   Application.ScreenUpdating = False  
   arr = Split(«Гор Каш Вол Нау»)  
   With Sheets(«Лист2»)  
   .Range(.[AZ3], .Range(«A» & .Rows.Count).End(xlUp)).ClearContents
   End With  
   For Each sh In arr  
       With Sheets(sh)  
           .Range(.[AZ3], .Range(«A» & .Rows.Count).End(xlUp)).Copy Sheets(«Лист2»).Range(«A» & .Rows.Count).End(xlUp).Offset(1)
       End With  
   Next  
   Application.ScreenUpdating = True  
End Sub

Hugo

Пользователь

Сообщений: 23251
Регистрация: 22.12.2012

Юрий, справедливо.    
Тем более если в этом файле поудалять все ненужные строки с формулами ниже данных и запаковать в архив — то думаю много и не будет.  
Не проверял, ибо там пароли  
Были

AcademiC

Пользователь

Сообщений: 43
Регистрация: 01.01.1970

Юрий М  

  Прошу прощения, хотел как лучше…  

  Hugo  

  А запороленные листы могут стать проблемой для работы макроса? Специально блокировал листы для изменения, чтобы пользователи не меняли структуру отчета…  

  Спасибо огромное за помощь, остался только один вопрос — не могу понять что поправить в макросе, чтобы он на листе «Лист2» не затирал шапку…? Сейчас данные вставляются не с 3-ей строчки а со второй + форматирование первой строки (заливка) остается, а вот вся внутрянка (формулы) пропадает…  

  Что я сделал опять не так?  

  Sub tt()  
    ‘Очищаем данные с листа:  
   With Sheets(«Лист2»)  
   .Range(.[AZ3], .Range(«A» & .Rows.Count).End(xlUp)).ClearContents
   End With  
    ‘заполняем лист данными:  
   Dim arr  
   Application.ScreenUpdating = False  
   arr = Split(«Гор Каш Вол Нау»)  
   With Sheets(«Лист2»)  
   .Range(.[AZ3], .Range(«A» & .Rows.Count).End(xlUp)).ClearContents
   End With  
   For Each sh In arr  
   With Sheets(sh)  
   .Range(.[AZ3], .Range(«A» & .Rows.Count).End(xlUp)).Copy Sheets(«Лист2»).Range(«A» & .Rows.Count).End(xlUp).Offset(1)
   End With  
   Next  
   Application.ScreenUpdating = True  
End Sub

AcademiC

Пользователь

Сообщений: 43
Регистрация: 01.01.1970

Так, простите… данные с листа и так очищаются — я туплю вставляя блок до коммента «‘заполняем лист данными:»… Извините.

Hugo

Пользователь

Сообщений: 23251
Регистрация: 22.12.2012

Да, неприятная мелочь. Просто я тестил на листе с уже скопированными данными, не заметил, что на пустом будет такой эффект…  
Можно поставить костыль так —    

     With Sheets(«Лист2»)  
   .[a3] = Now
   .Range(.[AZ3], .Range(«A» & .Rows.Count).End(xlUp)).ClearContents
   End With  

  Или ставить проверку на позицию последней заполненной строки, или иначе делать определение этого диапазона… Но зачем?  
Ну а на листе с заполненными данными ошибки не будет, т.е. если в А3 что-то записано, то порядок

AcademiC

Пользователь

Сообщений: 43
Регистрация: 01.01.1970

Hugo  

  …не выходит цветок каменный…  

  Файл во вложении.  

  Если оставить .[a3] = Now —> затирает часть шапки…при повторном запуске появляется пустая строка…

Hugo

Пользователь

Сообщений: 23251
Регистрация: 22.12.2012

Вот так работает:  

    Sub tt()  
   Dim arr  
   Application.ScreenUpdating = False  
   arr = Split(«Гор Каш Вол Нау»)  
   With Sheets(«Лист2»)  
   .[A3] = Now
   .Range(.[AZ3], .Range(«A» & .Rows.Count).End(xlUp)).ClearContents
   End With  
   For Each sh In arr  
   With Sheets(sh)  
   .Range(.[AZ3], .Range(«A» & .Rows.Count).End(xlUp)).Copy Sheets(«Лист2») _
   .Range(«A» & .Rows.Count).End(xlUp).Offset(1)  
   End With  
   Next  
   Application.ScreenUpdating = True  
End Sub  

    Зачем оффсет меняли?  
.[A2] = Now тоже совершенно ни к чему, там ведь уже есть данные, т.е. в этом действии логики нет.

AcademiC

Пользователь

Сообщений: 43
Регистрация: 01.01.1970

Уважаемые форумчане, можете еще раз по коду помочь — я правильно понимаю логику?  

  Sub tt()  
   Dim arr  

  ‘ вводим переменную «arr», которая явно не определена, т.е. с типом «variant»  

     Application.ScreenUpdating = False  

  ‘ запрещаем обновление экрана во время работы подпрограммы (sub) для ускорения выполненя  

     arr = Split(«Гор Каш Вол Нау»)  

  ‘ в справке тьма-тьмущая вариантов «split», я могу только догадываться — это какое-то явное указание листов, которые будут использоваться в данной процедуре?  

     With Sheets(«Лист2»)  

  ‘ указание одного объекта — «Лист2» над которым планируется совершать ряд операций?  

     .[A2] = Now

  ‘ Что-то типа указания ячейки А2 как ActiveCell?  

     .Range(.[AZ3], .Range(«A» & .Rows.Count).End(xlUp)).ClearContents

  ‘ понимаю, что очищает данные на листе «Лист2», но логики работы не понимаю… почему начинаем очищать не с А3, а с AZ23? Почему метод «.End» с константой «xlUp»… не понимаю логики… мы считаем заполненный ячейки снизу?      

  End With  
   For Each sh In arr  

  ‘ «sh» — но ведь переменная «sh» неопределена… как это вообще работает?  

     With Sheets(sh)  
   .Range(.[AZ3], .Range(«A» & .Rows.Count).End(xlUp)).Copy Sheets(«Лист2») _
   .Range(«A» & .Rows.Count).End(xlUp).Offset(2)  

  ‘ «Offset(2)» — свойство Range, которое задает смещение на 2 строки вниз?  

     End With  
   Next  
   Application.ScreenUpdating = True  
End Sub

AcademiC

Пользователь

Сообщений: 43
Регистрация: 01.01.1970

{quote}{login=Hugo}{date=17.06.2012 11:40}{thema=}{post}Вот так работает  
……………….  
.[A2] = Now тоже совершенно ни к чему, там ведь уже есть данные, т.е. в этом действии логики нет.{/post}{/quote}
Hugo, огромнейшее Вам спасибо! Я бы сам это неасилил… в обозримом будущем точно… не могу вкурить я этот язык и логику…

Hugo

Пользователь

Сообщений: 23251
Регистрация: 22.12.2012

Split — это разбиваем строку в массив. По умолчанию, если не указано, то по пробелам. Получаем массив  имён листов.  
.[A2] = Now — это в ячейку A2 Sheets(«Лист2») заношу сегодняшнюю дату. Вообще не важно что туда нужно занести, но т.к. там даты — пусть будет дата

  .Range(.[AZ3], .Range(«A» & .Rows.Count).End(xlUp)).ClearContents — всё правильно поняли.
Определяем по столбцу A последнюю заполненную ячейку — к ней идём снизу от последней строки вверх  
Если в столбце нет пустот — то можно и сверху идти, но надёжнее снизу (не всегда кратчайший путь верный :))  
Ну а как выделять диапазон — всё равно, я выделяю справа налево. т.к. так писать меньше (иначе нужно описать последнюю в AZ исходя от последней в A, что геморнее…)  

  «sh» не определена — да, забыл. Можете написать    
   Dim arr As Variant  
   Dim Sh As Variant  
но именно As Variant.  

  С Offset всё верно, кроме того, что нужно 1, а не 2.  
Но это непринципиально  

  А так логика вроде нормальная, всё просто и обоснованно

Hugo

Пользователь

Сообщений: 23251
Регистрация: 22.12.2012

Вернее Now — это не дата, а именно «сейчас», т.е. дата со временем. Но не суть, форматом показывает дату

AcademiC

Пользователь

Сообщений: 43
Регистрация: 01.01.1970

{quote}{login=Hugo}{date=18.06.2012 12:21}{thema=}{post}А так логика вроде нормальная, всё просто и обоснованно :){/post}{/quote}  
Еще раз спасибо.  

  …осталось только понять ЧТО и главное СКОЛЬКО надо скурить, чтобы во всем этом разобраться… формулы, даже замороченные, в Excel как-то попроще давались…

Hugo

Пользователь

Сообщений: 23251
Регистрация: 22.12.2012

Мне наоборот.  
Может потому, что я не курю?

AcademiC

Пользователь

Сообщений: 43
Регистрация: 01.01.1970

Hugo, можно final qustion?  

  Немного видоизменил условия сбора информации — макрос находится в другом файле в той же папке, где и файл «Отчет».  

  Методом «тыка» смог обратиться к файлу «Отчет», чтобы макрос собирал данные из него… а как указать, чтобы после сбора данных копирование происходило не в файл «Отчет, а в тот файл, в котором находится макрос (файл с макросом назвал «Сводный.xlsm»?  

  Конкретно:  

    Sub Sammary2()  
   Dim Manager_lists  
       ChDir «H:WORKОтчет»  
       Workbooks.Open Filename:=»H:WORKОтчет.xls»  
       Application.ScreenUpdating = False  
   With ActiveWorkbook  
   Manager_lists = Split(«Гор Каш Вол Нау»)  
   End With  
       With Sheets(«Сводный»)  
           .[A3] = Now
           .Range(.[AZ3], .Range(«A» & .Rows.Count).End(xlUp)).ClearContents
       End With  
   For Each sh In Manager_lists  
   With Sheets(sh)  
   .Range(.[AZ3], .Range(«A» & .Rows.Count).End(xlUp)).Copy Sheets(«Ñâîäíûé») _
   .Range(«A» & .Rows.Count).End(xlUp).Offset(1)  
   End With  
   Next  
   Application.ScreenUpdating = True  
End Sub  

    Макрос прерывается с ошибкой на 9 строке («With Sheets(«Сводный»)»), что логично, так как в файле Отчет.xls (из которого и собираем данные по листам) нет такого листа как «Сводный», этот лист находится в файле Сводный.xlsm.

Hugo

Пользователь

Сообщений: 23251
Регистрация: 22.12.2012

Вообще-то достаточно указать книгу:  

  With ThisWorkbook.Sheets(«Сводный»)  

  Но есть ещё замечания — и по открытию книги (я бы сделал иначе), и по .Rows.Count — теоретически и тут может быть брак.  
Чуть позже напишу свой вариант, как время будет.

Hugo

Пользователь

Сообщений: 23251
Регистрация: 22.12.2012

Вот вроде так может быть, без проверки:  

  Sub Sammary3()  
   Dim Manager_lists, sh, sh_sv As Worksheet  

     Manager_lists = Split(«Гор Каш Вол Нау»)    ‘получаем массив названий  
   Set sh_sv = ThisWorkbook.Sheets(«Сводный»)    ‘получаем ссылку на лист  

         Application.ScreenUpdating = False  

         With sh_sv  
       .[A3] = Now ‘подстраховка от пустого диапазона
       .Range(.[AZ3], .Range(«A» & .Rows.Count).End(xlUp)).ClearContents ‘очистка
   End With  

     ChDir «H:WORKОтчет» ‘это в общем не нужно, но и не мешает  

         With Workbooks.Open(«H:WORKОтчет.xls»)    ‘открываем файл отчёта  
       For Each sh In Manager_lists    ‘цикл по названиям листов  
           With .Sheets(sh)    ‘обращаемся к очередному листу  
               .Range(.[AZ3], .Range(«A» & .Rows.Count).End(xlUp)).Copy _
                       sh_sv.Range(«A» & sh_sv.Rows.Count).End(xlUp).Offset(1) ‘копирование  
           End With  
       Next  
       .Close 0    ‘закрываем отчёт без сохранения изменений (хотя их и не вносили)  
   End With  

     Application.ScreenUpdating = True  
End Sub  

  В этом коде нет ориентации на активную книгу/лист, что надёжнее.  
Ещё вместо Workbooks.Open можно использовать getobject() — тогда не будет ошибки, если эта книга уже открыта. Но тогда нужно подумать, что делать в конце, если она была открыта

Guest

Гость

#25

18.06.2012 12:53:13

Hugo, спасибо все работает.  

  …буду разбираться в коде и применяемых методах…