Копирование диапазона из двух книг в одну (несколько листов)

@valve · Регистрация: 08.05.2013

Author24 — интернет-сервис помощи студентам

Здравствуйте. Хочу попросить помощи в решении одной задачи в Excel 2010. Пытаюсь создать макрос, который бы подтягивал в книгу "ФКС" диапазон данных из книг "Продажи1" и "Продажи2". Они в момент обращения к ней открыты. Затык для меня в двух местах.
1. В книгах-источниках 6 листов (с названиями месяцев), с которых нужно подтянуть данные, точно такие же листы и в книге, куда нужно поместить данные. Причём с каждого листа двух книг поместить строки друг под другом на один лист результирующей книги (под шапку, которая занимает первую строку и неизменна). Я пока смог только добиться копирования строк из одного файла и с одного листа, и я не понимаю, как это сделать для остальных листов.
2. Диапазон для копирования может содержать разное количество строк. То есть в одной книге их может быть 5, в другой 20.

Вижу, что описание задачи сумбурное, поэтому в приложенных книгах я поместил примечания. Также постарался нарисовать картинку по вышеописанным условиям.

@Hugo121 · 08.05.2013, 11:24

Visual Basic

Sub tt()
    Dim wb1 As Workbook, wb2 As Workbook
    Dim sh As Worksheet, s$
 
    Set wb1 = Workbooks("Продажи1")
    Set wb2 = Workbooks("Продажи2")
 
    For Each sh In ThisWorkbook.Worksheets
        s = sh.Name
        If s <> "Коэффициенты" Then
            With wb1.Sheets(s)
                .Range("O4:A" & .Range("A" & .Rows.Count).End(xlUp).Row).Copy sh.Cells(sh.Rows.Count, "A").End(xlUp)(2)
            End With
            With wb2.Sheets(s)
                .Range("O4:A" & .Range("A" & .Rows.Count).End(xlUp).Row).Copy sh.Cells(sh.Rows.Count, "A").End(xlUp)(2)
            End With
        End If
    Next
 
End Sub

Код в сводном файле (в стандартном модуле).
Все книги должны быть открыты - лениво диалог открытия прописывать...

@valve · 10.05.2013, 13:53 **[ТС]**

Спасибо за быстрый ответ! Код работает прекрасно, особенно учитывая моё описание задачи

Если не лень, не могли бы вы помочь доработать его с тем учётом, что файлы находятся в разных папках (ФКС на одном компе, Продажи1 и Продажи2 на других). Я попробовал внести модификацию в ваш код, использовав вместо

Visual Basic

1	Set wb1 = Workbooks("Продажи1")

конструкцию

Set wb1 = Workbooks.Open("_path_Продажи1.xlsx")

вместо _path_ указав путь к файлу. Результат есть, однако при этом файлы "Продажи1" и "Продажи2" открываются у меня локально, хотя это не нужно, а нужно только взять из них данные. Я не совсем точно выразился, что они открыты, имел в виду, что они открыты, но на других компах.
И ещё, пытался сделать очистку диапазона, куда будут вставляться данные, с помощью

Visual Basic

1	ThisWorkbook.Sheets(MySheet).Range("A2:O200").ClearContents

Цель этого добиться, чтобы каждый раз при операции извлечения данных они вставлялись на пустое место. Этот кусок я вставил в код, однако этим достиг только очистки диапазона в файлах источниках.

Добавлено через 38 минут

Сообщение от valve

сделать очистку диапазона, куда будут вставляться данные

и очистка делается только на одном листе, имя которого указано вместо MySheet

@Hugo121 · 10.05.2013, 14:25

Не понял, чем открытие не нравится? Открыли, взяли данные, закрыли.
Если не делать application.screenupdating, то и не заметите (ещё на это время отключить ShowWindowsInTaskbar, чтоб уж совсем...)
Или вместо Workbooks.Open попробуйте getobject, только в конце обязательно закройте файл! А то так и останется висеть, пока Эксель не закроете.
Ещё можно данные брать с помощью ADO, но я в нём не очень...
Ну а очистка так:

Visual Basic

1 2	If s <> "Коэффициенты" Then sh.Range("A2:O200").ClearContents

Хотя я бы и тут добавил динамическое определение диапазона.

@valve · 11.05.2013, 00:23 **[ТС]**

Hugo121, внёс добавления согласно вашим указаниям. Заюзал и Application.ScreenUpdating=false, и Application.ShowWibdowsInTaskbar=false. И очистку добавил. Статическую, но рад и этому. Насчёт динамического определения диапазона для очистки, конечно, идея отличная, но пока метод тыка, совмещённый с гуглом, не сработал.

@Hugo121 · 11.05.2013, 00:31

Так вот же:

Visual Basic

1	.Range("O4:A" & .Range("A" & .Rows.Count).End(xlUp).Row)

Чуть изменить по задаче (4->2) и готово.

@valve · 11.05.2013, 00:34 **[ТС]**

А, добавил же ещё закрытие (стр. 8, 29-31)

Visual Basic

Sub PullData()
 
Application.ScreenUpdating = False
Application.ShowWindowsInTaskbar = False
    
    Dim wb1 As Workbook, wb2 As Workbook
    Dim sh As Worksheet, s$
    Dim WbName As Object
 
    Set wb1 = Workbooks.Open("E:\test\Excel\Продажи1.xlsx")
    Set wb2 = Workbooks.Open("C:\test\Excel\Продажи2.xlsx")
    
    For Each sh In ThisWorkbook.Worksheets
        s = sh.Name
        If s <> "Коэффициенты" Then
            sh.Range("A2:O999").ClearContents
            
            With wb1.Sheets(s)
                .Range("O4:A" & .Range("A" & .Rows.Count).End(xlUp).Row).Copy sh.Cells(sh.Rows.Count, "A").End(xlUp)(2)
            End With
            
            With wb2.Sheets(s)
                .Range("O4:A" & .Range("A" & .Rows.Count).End(xlUp).Row).Copy sh.Cells(sh.Rows.Count, "A").End(xlUp)(2)
            End With
            
        End If
    Next
 
    For Each WbName In Application.Workbooks()
        If WbName.Name <> ThisWorkbook.Name Then WbName.Close
    Next
    
Application.ScreenUpdating = True
    
End Sub

@Hugo121 · 11.05.2013, 15:58

Чуть проще:

Visual Basic

Sub PullData()
 
    Dim wb1 As Workbook, wb2 As Workbook
    Dim sh As Worksheet, s$
 
    With Application
        .ScreenUpdating = False
        .ShowWindowsInTaskbar = False
 
 
        Set wb1 = Workbooks.Open("E:\test\Excel\Продажи1.xlsx")
        Set wb2 = Workbooks.Open("C:\test\Excel\Продажи2.xlsx")
 
        For Each sh In ThisWorkbook.Worksheets
            s = sh.Name
            If s <> "Коэффициенты" Then
                sh.Range("A2:O999").ClearContents
 
                With wb1.Sheets(s)
                    .Range("O4:A" & .Range("A" & .Rows.Count).End(xlUp).Row).Copy sh.Cells(sh.Rows.Count, "A").End(xlUp)(2)
                End With
 
                With wb2.Sheets(s)
                    .Range("O4:A" & .Range("A" & .Rows.Count).End(xlUp).Row).Copy sh.Cells(sh.Rows.Count, "A").End(xlUp)(2)
                End With
 
            End If
        Next
 
        wb1.Close False
        wb2.Close False
 
        .ScreenUpdating = True
        .ShowWindowsInTaskbar = True
    End With
End Sub

А закрывать все книги кроме текущей (или с кодом) нельзя - у меня например всегда открыты 4 скрытых.
Да и мало ли какие книги перед этой работой открыл пользователь и не закрыл...

@valve · 11.05.2013, 21:48 **[ТС]**

Спасибо, я как-то не подумал, что он же все файлы без сохранения закроет. А правильно ли я понимаю, что теоретически, продублировав фрагмент с соответствующим изменением номера (wb#)и объявив wb# заранее

Visual Basic

1
2
3

With wb#.Sheets(s)
      .Range("O4:A" & .Range("A" & .Rows.Count).End(xlUp).Row).Copy sh.Cells(sh.Rows.Count, "A").End(xlUp)(2)
End With

можно брать данные из любого количества листов?

@Hugo121 · 11.05.2013, 22:03

Он и так берёт из любого количества листов. Но из двух указанных книг.
Если количество книг может быть любым - можно подключить диалог выбора книг, и затем перебирать полученный массив имён - сперва все открыли, затем из всех копируем. Ну там может быть несколько вариантов решения - например можно создать коллекцию объектов, или собрать их в словарь.
Но если книг мало, и они всегда известны - тогда проще продублировать этот блок несколько раз (копипаст рулит

)

@valve · 12.05.2013, 12:59 **[ТС]**

Сообщение от Hugo121

из любого количества листов

Конечно, я имел в виду книги, просто невнимательность.

@valve 5 / 4 / 1 Регистрация: 08.05.2013 Сообщений: 14
	11.05.2013, 00:23 [ТС]	5
	Hugo121, внёс добавления согласно вашим указаниям. Заюзал и Application.ScreenUpdating=false, и Application.ShowWibdowsInTaskbar=false. И очистку добавил. Статическую, но рад и этому. Насчёт динамического определения диапазона для очистки, конечно, идея отличная, но пока метод тыка, совмещённый с гуглом, не сработал. 0

@Hugo121 6922 / 2832 / 543 Регистрация: 19.10.2012 Сообщений: 8,645
	11.05.2013, 22:03	10
	Он и так берёт из любого количества листов. Но из двух указанных книг. Если количество книг может быть любым - можно подключить диалог выбора книг, и затем перебирать полученный массив имён - сперва все открыли, затем из всех копируем. Ну там может быть несколько вариантов решения - например можно создать коллекцию объектов, или собрать их в словарь. Но если книг мало, и они всегда известны - тогда проще продублировать этот блок несколько раз (копипаст рулит ) 1

@valve 5 / 4 / 1 Регистрация: 08.05.2013 Сообщений: 14
	12.05.2013, 12:59 [ТС]	11
	Сообщение от Hugo121 из любого количества листов Конечно, я имел в виду книги, просто невнимательность. 0