Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Как скопировать данные из однотипных листов нескольких книг на один лист?
 
Здравствуйте!

Имеется следующая ситуация. Необходимо собрать сведения от 26 организаций. Им созданы одного вида книги (образцы) в таблицы которых они вносят данные. Данных, у каждой конторы, может быть разное количество (т.е. копировать макросом заранее заданный диапазон не получается). Имеется сводная книга (свод), в которую надо скопировать все данные из образцов. Как реализовать это таким образом, чтобы макрос копировал нужное количество строк (столько, сколько заполнила каждая организация) и вставлял на следующую незаполненную в своде строчку (т.е. сразу после предыдущей организации)?

Вариант с копирование заранее заданного диапазона с большим запасом и последующим ручным (пока не знаю, как это сделать автоматически) удалением строк - не очень нравится. Есть мысли насчет функции СЧЁТЗ, чтобы она считала сколько нужно скопировать, но как дать понять, куда это нужно вставлять?

Надеюсь, изложил понятно. Книги прикрепил.
Изменено: postebaylo - 14 Апр 2018 20:34:44
 
postebaylo, подобных тем уже было немало. Искать пробовали?
 
Тему нужно  назвть более конкретно, по задаче. Предложите, модераторы заменят
 
Умное копирование строк
Изменено: postebaylo - 14 Апр 2018 21:21:29
 
postebaylo, название темы поменял. Вот скажите мне - такая формулировка больше расскажет о задаче, чем Ваш вариант "Умное копирование"?
 
Да, спасибо, так лучше
Изменено: postebaylo - 14 Апр 2018 21:21:18
 
postebaylo,видимо помогающим предоставляется возможность самостоятельно заполнить образец и решить попутно проблему?

Как вариант держать все книги по организациям в одной папке и оттуда добывать инфу циклом. Другой вариант - на скрытом листе разместить пути к файлам (если они на сетевом диске). В этих файлах данные за конкретную дату? Т.е. копировать нужно все, или как-то иначе?
Изменено: Anchoret - 14 Апр 2018 20:55:21
 
postebaylo, запомните: кнопка цитирования не для ответа!
Цитата
postebaylo написал:
чтобы макрос копировал нужное количество строк (столько, сколько заполнила каждая организация
В Вашем примере нет ни одной заполненной строки в файлах-донорах.
Вопросы:
1. Откуда в файле-сборщике взялись даты в столбце В?
2. Откуда номера в столбце А?
3. Нужно ли копировать три первых строки, расположенных над шапкой таблицы?
4. Как Вы поймёте, где заканчиваются данные одной организации и начинаются данные другой?
 
26 организаций заполняют единой формы образец. Затем все образцы открываются (просто открываются 26 книг), открывает свод в неи запускается скрипт и происходит копирование. Параметры которого необходимо правильно задать.

Покумекал я и понял. Через СЧЁТЗ(D:D)-2 в первом образце считаем, сколько строк с данными внесла первая организация. Вводим под эту цифру переменную X. Затем копируем диапазон D6:AIX и вставляем в свод на ячейку D6. Затем на втором образце проделываем тоже самое, что делали на первом (т.е. копируем диапазон строк, в которые организация внесла данные). Переключаемся на свод и там ищем первую пустую ячейку, к примеру по столбцу D. И вставляем в нее из буфера. И так до конца.
Не могу сообразить как это реализовать.
Изменено: postebaylo - 14 Апр 2018 21:21:42
 
postebaylo, если Вы не вернётесь в свои сообщения у не удалите бездумное цитирование, то я закрою тему.
 
Юрий М,не заметил вашего сообщения. Виноват (нашел кнопку "имя")

Цитата
Юрий М написал: 1. Откуда в файле-сборщике взялись даты в столбце В?
при открытии свода - выскакивает календарик. после выбора даты она записывается в столбец B

Цитата
2. Откуда номера в столбце А?
Пока проставил вручную. В идеале: чтобы растягивалась настолько, сколько всего будет данных (строк) от всех организаций. Чтобы был счет им.

Цитата
3. Нужно ли копировать три первых строки, расположенных над шапкой таблицы?
Нет, только с 6 строки включительно

Цитата
4. Как Вы поймёте, где заканчиваются данные одной организации и начинаются данные другой?
столбец C - имя организации. Не проставил в прикрепленных файлах
 
Опять Вы цитируете... Да что же за тягоа такая у Вас к цитированию?
По первому пункту: у меня вот нет такого календаря - и что делать?
 
Юрий М, Странно. В макросе книги свод в самом начале прописан календарь и запись даты в B6
Код
Private Sub CommandButton1_Click()
Sheets("дефектные").Select
Range("B6").Value = UserForm1.DTPicker1.Value

Но вообще, календарь - это не самое важное
Изменено: postebaylo - 15 Апр 2018 00:13:30
 
Ничего странного: на моём компьютере нет DTPicker.
См. вариант: нашёл чей то макрос и подредактировал его.
Внимание! Все файлы (26 доноров и один сборщик) должны находиться в одной папке. Других файлов там не должно быть.
 
По открытым книгам:
Код
Sub MassCopy()
Dim a&, arr(), x&, sWB As Workbook, nWB As Workbook
a = Columns("D:AI").Find(What:="*", SearchDirection:=2, SearchOrder:=1).Row + 1
Set sWB = ThisWorkbook
For Each nWB In Workbooks
  If sWB.Name <> nWB.Name Then
    x = nWB.Sheets(1).Columns("D:AI").Find(What:="*", SearchDirection:=2, SearchOrder:=1).Row
    If x > 5 Then
      arr = nWB.Sheets(1).Columns("D:AI").Rows("6:" & x).Value
      sWB.Sheets(1).Range("D" & a).Resize(UBound(arr, 1), UBound(arr, 2)) = arr
      a = a + UBound(arr)
    End If
  End If
Next
End Sub
 
Товарищи, спасибо большое!
Но я планировал реализовать эту опцию внутри UserForm1, чтобы она отрабатывала сразу, после выбора даты в календаре.
Там уже прописано копирование фиксированных диапазонов из каждого образца. А диапазон в данном случае - изменяющийся. Т.е. макрос должен "увидеть" сколько строк ему скопировать из каждого образца (может быть через счетз в книге будет происходить подсчет строк с данными, эта цифра записываться в ячейку, значение этой ячейки будет присваиваться переменной в макросе и потом эта переменная будет стоять в координатах ячейки, что будет второй ячейкой в диапазоне выделения (выше я обозначил ее X)).

Код простой, я бы даже сказала школьный курс, но я хочу доработать его, усовершенствовать. Добавить туда эту переменную, мб какой счетчик
Код
Private Sub CommandButton1_Click()Sheets("дефектные").Select
Range("B6").Value = UserForm1.DTPicker1.Value

On Error Resume Next
Windows("02.xls").Activate 'переключение на образец от первой организации
If Err = 0 Then
    Range("D6:AI6").Select 'здесь должен быть выбор D6:AIX, т.е. выделение от начала до последней строки, в которую внесла данные организация
    Selection.Copy
    Windows("свод.xlsm").Activate 'переключаемся на свод
    Range("D6").Select 'указываем куда вставлять. это первая вставка, поэтому начинаем с начала таблицы
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Windows("02.xls").Activate
    ActiveWindow.Close SaveChanges:=False

    
End If
On Error GoTo 0

On Error Resume Next
Windows("03.xls").Activate 'переключение на образец от второй организации
If Err = 0 Then

    Range("D6:AI6").Select 'здесь должен быть выбор D6:AIX т.е. выделение от начала до последней строки, в которую внесла данные организация

    Selection.Copy
    Windows("свод.xlsm").Activate 'переключаемся на свод
    Range("DX+6").Select 'указываем куда вставлять
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Windows("03.xls").Activate
    ActiveWindow.Close SaveChanges:=False
Изменено: postebaylo - 15 Апр 2018 10:35:59
 
ребзи, ну подсобите плз
 
Цитата
postebaylo написал:
Но я планировал реализовать эту опцию внутри UserForm1, чтобы она отрабатывала сразу, после выбора даты в календаре.
Так вызывайте мой макрос после выбора даты.
 
postebaylo - просто постебаться заглянул
 
Юрий М, как изменить макрос что-бы не указывал порядковые числа строки? Когда запускал макрос при копировании слева первой колонке появились какие то  порядковые номера.
Изменено: maryo - 16 Апр 2018 16:41:55
 
Собрать данные с однотипных книг на один лист можно с помощью Power Query. В приемах есть статья.
 
Это номера из фалов-доноров. Если их не нужно забирать, то измените строку:
.Range(.Cells(6, 1), .Cells(TmpLastRow, 35)).Copy MainWB.Sheets(1).Cells(FreeRow, 1)
на
.Range(.Cells(6, 2), .Cells(TmpLastRow, 35)).Copy MainWB.Sheets(1).Cells(FreeRow, 1)
 
Юрий М, Вы чудеса творите, спасибо большое !!!
Страницы: 1
Читают тему (гостей: 2)
Наверх