Код консолидатора - как объединить несколько книг

Question

У меня есть код VBA, который выглядит следующим образом:

Sub GetSheets()
    Path = "C:\Users\DDC\Desktop\data\"
    Filename = Dir(Path & "*.xls")
    Do While Filename <> ""
        Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
        For Each Sheet In ActiveWorkbook.Sheets
            Sheet.Copy After:=ThisWorkbook.Sheets(1)
        Next Sheet
        Workbooks(Filename).Close
        Filename = Dir()
    Loop
End Sub

Этот код VBA объединяет несколько Excel в один Excel с разными листами. Если у нас есть 100 Excel, запуск этого кода в пустой ячейке объединит новый пустой Excel со 100 листами. Например, предположим, что у меня есть 2 разных Excel с аналогичным форматом (содержащие одинаковые заголовки), каждый из которых содержит 10 строк данных.

Мое требование состоит в том, что после запуска этого кода я хочу, чтобы в o / p excel был только 1 лист с 20 строками данных, объединенных в один лист. Мне не нужны 2 отдельных листа.

В настоящее время я пытаюсь сделать то же самое для 95 листов, и если мне придется вручную копировать каждый лист на основной лист, то в этом коде нет смысла.

Answer 1

Пожалуйста, попробуйте этот код после прочтения комментариев и, возможно, внесения некоторых изменений в то, что скопировано. Код будет определять ширину каждого листа исходных данных шириной строки 1 (предполагая, что она содержит заголовки для всех столбцов). Он определит длину всех столбцов по длине столбца A (предполагая, что это самый длинный). Наконец, предполагается, что вы не хотите, чтобы заголовки повторялись повсюду, и поэтому берет данные только из строки 2 на каждом исходном листе. Все эти параметры вы можете установить в соответствии с вашими потребностями.

Sub GetSheets () '021

' Const Path As String = "C: \ Users \ DDC \ Desktop \ data \ «Dim FileName As String Dim WsS As Worksheet» Источник данных Dim WsT As Worksheet »Назначение данных Dim Rng As Range Dim Cl As Long» последний столбец в последней строке WsS Dim Rl As Long (чередование WsS и WsT)

' it's faster this way but you won't see what's happening
Application.ScreenUpdating = False
Set WsT = ThisWorkbook.Worksheets("Sheet1")

FileName = Dir(Path & "*.xls*")
Do While FileName <> ""
    Workbooks.Open FileName:=Path & FileName, ReadOnly:=True
    For Each WsS In ActiveWorkbook.Worksheets
        With WsS
            ' this finds the last used column in row #1
            ' columns to the right of this will not be copied
            ' adjust row number to suit
            Cl = .Cells(1, .Columns.Count).End(xlToLeft).Column
            ' this finds the last used row in column A
            ' rows below this (in other columns) will not be copied
            ' adjust the column name to suit
            Rl = .Cells(.Rows.Count, "A").End(xlUp).Row
            ' the range to be copied will start at row #2, cluding row #1
            ' which is presumed to contain captions
            ' adjust row number to suit
            Set Rng = .Range(.Cells(2, 1), .Cells(Rl, Cl))

            Rl = WsT.Cells(WsT.Rows.Count, "A").End(xlUp).Row + 1
            Rng.Copy Destination:=WsT.Cells(Rl, 1)
        End With
    Next WsS
    Workbooks(FileName).Close saveChanges:=False
    FileName = Dir()
Loop
Application.ScreenUpdating = True

End Sub

В вашем запросе не указано, сколько листов содержится в каждой исходной книге, но вы кодируете их все, и, следовательно, мой тоже. На самом деле существует вероятность, что в каждой книге будет только один рабочий лист. В этом случае «Все» означает 1. Но если есть также пустые рабочие листы, «все» может означать, что будут скопированы пустые строки с пустых листов. Я не предусмотрел этого.

Answer 2

Может быть что-то вроде этого:

Sub GetSheets()
lr1 = Columns(1).Rows.Count
Set target = ThisWorkbook.ActiveSheet
Path = "C:\Users\DDC\Desktop\data\"
Filename = Dir(Path & "*.xls")
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
With Sheets(Sheet.Name) 'change "A" according to your need - change 15 according to your need
lr = .Columns(1).Rows.Count
.Range("A2", .Range("A" & lr).End(xlUp).Offset(0, 15)).Copy Destination:=target.Range("A" & lr1).End(xlUp).Offset(1, 0)
End With
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
End Sub

Предполагая, что все таблицы данных ваших книг имеют одинаковую структуру, которая начинается в столбце A, код будет копировать каждый лист в каждой открытой книге в l oop начинается с ячейки A2 до последней строки столбца P, затем вставляется в книгу, где находится макрос, начинается с последней пустой строки столбца A.

Код завершится ошибкой, если структура таблицы данных не будет одинаковой на каждом лист каждой рабочей тетради. Например: есть таблица данных, которая начинается от столбца A до столбца D, и есть другая таблица данных, которая начинается со столбца B до столбца E.

Код также завершится ошибкой, если в таблице есть пустой лист. открыть книгу в l oop, потому что код сначала не проверяет, есть ли пустой лист (или заголовок таблицы без данных) в открытой книге в l oop. Например: в открытой книге Sheet1 есть данные, Sheet2 пуст (или только заголовок в первой строке, но нет данных), Sheet3 есть данные.