В общем-то проблема не такая распространенная, как сбор данных из нескольких файлов/листов в Excel, но все же. Решил вот написать, как просто и быстро можно из множества текстовых файлов собрать информацию в один новый текстовый файл. Притом это не потребует от Вас никаких усилий, кроме как нажатия кнопочки и выбора нужных файлов. Ну и скачивания файла с этой странички. Или ручной вставки кода в свою книгу. Собственно, сам код:

Sub Get_All_TXT_Text()
    Dim avFiles, li As Long
    avFiles = Application.GetOpenFilename("TXT Files(*.txt),*.txt", , , , True)
    If VarType(avFiles) = vbBoolean Then Exit Sub
    Dim objFSO As Object, objTxtFile As Object, sTxt, sAllTxt
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    For li = LBound(avFiles) To UBound(avFiles)
        Set objTxtFile = objFSO.OpenTextFile(avFiles(li), 1)
        sTxt = objTxtFile.ReadAll
        sAllTxt = sAllTxt & vbNewLine & sTxt
        objTxtFile.Close
    Next li
    Set objTxtFile = objFSO.CreateTextFile("C:/AllText.txt", True)
    objTxtFile.WriteLine sAllTxt
    objTxtFile.Close
    Set objTxtFile = Nothing: Set objFSO = Nothing
End Sub

Sub Get_All_TXT_Text()
    Dim avFiles, li As Long
    avFiles = Application.GetOpenFilename("TXT Files(*.txt),*.txt", , , , True)
    If VarType(avFiles) = vbBoolean Then Exit Sub
    Dim objFSO As Object, objTxtFile As Object, sTxt, sAllTxt
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    For li = LBound(avFiles) To UBound(avFiles)
        Set objTxtFile = objFSO.OpenTextFile(avFiles(li), 1)
        sTxt = objTxtFile.ReadAll
        sAllTxt = sAllTxt & vbNewLine & sTxt
        objTxtFile.Close
    Next li
    Set objTxtFile = objFSO.CreateTextFile("C:/AllText.txt", True)
    objTxtFile.WriteLine sAllTxt
    objTxtFile.Close
    Set objTxtFile = Nothing: Set objFSO = Nothing
End Sub

Вот и все. Теперь этот код необходимо вставить в стандартный модуль и…Пользоваться!
После работы кода на диске «С» будет создан файл «AllText.txt», в котором и будут содержаться данные всех выбранных файлов.

Скачать пример »

Так же см.:
Сбор данных с нескольких листов/книг
Как собрать данные с нескольких листов или книг?

 
Еще одна распространенная проблема, с которой сталкивались многие, кто работает в Excel. Когда необходимо собрать данные за месяц, год, годы… А данные расположены в разных папках, книгах и не на одном листе. И руками собирать не всегда быстро получается, особенно если книг более 50.
Данная команда поможет сделать это чуть быстрее.

Собрать данные со всех листов выбранных книг — собираются данные со всех листов книг, которые присутствуют в ListBox(окно с именами файлов).

Собрать данные с одного листа выбранных книг — данные собираются только с листа, имя которого совпадает с указанным в поле. Делится на два значения:

• Номер листа — указывается порядковый номер листа, с которого собирать данные. Можно применять символы подстановки — * и ?. Например, указав 1* Вы в итоге соберете данные со всех листов, индекс которых начинается с 1(1,10,11,12,13,…,101,102 и т.д.), а указав 1? — 10,11,12,…,19.
• Имя листа — указывается имя листа, с которого собирать данные. Также как и с номером можно применять символы подстановки — * и ?. Взять пример с рисунка — *отчет*. Данные будут собраны со всех листов, в имени которых встречается «отчет» — первый отчет, 2 отчет, отчет №3, четвертый отчет за период и т.д.

Собрать данные со всех листов текущей книги — собираются данные со всех листов(кроме активного) активной книги.

Собирать диапазоны, начиная с указанной ячейки — данные с листов будут собираться начиная с ячейки, указанной в окне выбора. На рисунке указан адрес — Лист3!$A$5, следовательно данные будут собираться начиная именно с этой ячейки. Может пригодится, если в Ваших данных присутствуют заголовки, шапки и прочее. Просто указываете ячейку, с которой начинаются действительные данные. Применяя данную опцию необходимо следить, чтобы структура документов во всех книгах была одинакова.

Собирать только выбранный диапазон — будут собраны только указанные диапазоны. Актуально в случае, когда помимо шапки, есть еще и подпись(или что-то наподобии её).

Копировать только строку, в которой присутствует значение: — включение данной опции позволяет копировать из диапазонов листов лишь те строки, в ячейках которых присутствует указанное в текстовом поле значение. Можно применять символы подстановки — * и ?. На рисунке введено слово «*итог*«. Значит скопированы будут лишь те строки, в ячейках которых будет найдено слово или словосочетание, содержащие «итог«. Это и «подитог» и «промежуточный итог«, и «итого» и т.д.

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

Копировать только значения и форматы — в итоговый лист будут скопированы исключительно значения и форматы с выбранных файлов/листов. Это значит, что если в каких-либо листах есть формулы, то будет скопирован лишь результат их вычислений — сами формулы на итоговый лист не попадут. Может пригодиться, когда на листах для сбора есть много формул, ссылающихся на разные листы и книги. При копировании таких формул в итоговом листе может появиться ошибочное значение(#ССЫЛКА!, #Н/Д и др.).

Собирать с листа данные, если содержимое ячейки равно:

• Значению — в итоговый лист будут собраны данные лишь с тех листов, значение указанной ячейки в которых равно записанному в данное поле. Можно применять символы подстановки — * и ?. Если оставить пустым — появится сообщение, предупреждающее о пустом поле. Вы сможете либо согласиться собирать данные, если ячейка пустая, либо отменить выполнение и заполнить поле  значением. В примере указано значение «Ведомость» и ячейка, которой это значение просматривать: Лист3!$A$1. Значит данные будут собираться только с тех листов, содержимое ячейки A1 равно Ведомость.
• Содержимому ячейки — в итоговый лист будут собраны данные лишь с тех листов, значение указанной ячейки в которых равно значению в этой ячейке.

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

Добавить имена книг перед данными — в итоговый лист будет добавлен столбец, в который напротив каждого значения будет записано имя книги, с которой эти данные были занесены. Столбец добавляется первым столбцом(если также был выбран пункт — Добавить имена листов перед данными — то информация об именах книг будет добавлена перед информацией об именах листов). Пункт недоступен при выборе Собрать данные со всех листов текущей книги.

Преобразовать выбранные файлы в формат «.xlsx» — 2007 Excel — активна только при использовании надстройки в версии Excel, старше 2003. Преобразует выбранные для обработки файлы в формат 2007 Excel. Необходимо для тех случаев, когда собираемые данные могут занять больше места на листе, чем 65536 строк(максимум для 2003 Excel). А дело в том, что даже работая в 2007 Excel с файлами 2003 Вы сталкиваетесь со всеми ограничениями 2003 Excel(за исключением формул — они будут работать, но только при открытии файла в 2007).

Удалить преобразованные файлы после сбора данных — все в названии самого пункта. Если преобразованные файлы Вам не нужны после сбора данных — они удаляются. Исходники при этом никаким образом не пострадают.

Обновлять связи при открытии книг — по умолчанию данная опция отключена, т.к. в противном случае при открытии книги со связями будет появляться сообщении с предложением обновить или нет и так для каждой книги. А это редко когда требуется. Но если все же требуется обновлять связи — просто включите опцию.

Дополнение: Если полный путь к файлу не помещается в окне выбора файлов, а посмотреть его надо, то можно просто выделить этот файл в окне выбора файлов и внизу формы будет отображен полный путь к файлу.

Примечание: применять данную команду лучше либо создав предварительно новую книгу, либо создав в имеющейся новый лист и уже оттуда запускать. Иначе собираемые данные могут сдвинуться и будут занесены ниже имеющихся на листе.

Очень часто бывает необходимо собрать данные с нескольких листов, а то и книг. Вручную делать довольно муторно. Чтоб Вам было не так муторно делать эту работу — предлагаю простенькую процедурку, которая соберет данные из выбранных книг, указанных листов и указанного диапазона на один отдельный лист.

Option Explicit
Sub Consolidated_Range_of_Books_and_Sheets()
    Dim iBeginRange As Object, lCalc As Long
    Dim sRngAddress As String, oAwb As String, sCopyAddress As String, sSheetName As String
    Dim lLastrow As Long, lLastRowMyBook As Long, li As Long, iLastColumn As Integer
    Dim wsSh As Object, wsDataSheet As Object, bPolyBooks As Boolean, avFiles
    On Error Resume Next
    Set iBeginRange = Application.InputBox("Выберите диапазон сбора данных." & vbCrLf & _
                                           "1. При выборе только одной ячейки данные будут собраны со всех листов начиная с этой ячейки. " & _
                                           vbCrLf & "2. При выделении нескольких ячеек данные будут собраны только с указанного диапазона всех листов.", Type:=8)
    If iBeginRange Is Nothing Then Exit Sub
    sSheetName = InputBox("Введите имя листа, с которого собирать данные(если не указан, то данные собираются со всех листов)", "Параметр")
    If sSheetName = "" Then sSheetName = "*"
    On Error GoTo 0
    If MsgBox("Собрать данные с нескольких книг?", vbInformation + vbYesNo, "Excel-VBA") = vbYes Then
        avFiles = Application.GetOpenFilename("Excel files(*.xls*),*.xls*", , "Выбор файлов", , True)
        If VarType(avFiles) = vbBoolean Then Exit Sub
        bPolyBooks = True
    Else
        avFiles = Array(ThisWorkbook.FullName)
    End If
    With Application
        lCalc = .Calculation
        .ScreenUpdating = False: .EnableEvents = False: .Calculation = xlManual
    End With
    ThisWorkbook.Sheets.Add After:=Sheets(Sheets.Count)
    Set wsDataSheet = ThisWorkbook.ActiveSheet
    For li = LBound(avFiles) To UBound(avFiles)
        If bPolyBooks Then Workbooks.Open Filename:=avFiles(li)
        oAwb = Dir(avFiles(li), vbDirectory)
        For Each wsSh In Workbooks(oAwb).Sheets
            If wsSh.Name Like sSheetName Then
                If wsSh.Name = wsDataSheet.Name And bPolyBooks = False Then GoTo NEXT_
                With wsSh
                    Select Case iBeginRange.Count
                    Case 1
                        lLastrow = .Cells(1, 1).SpecialCells(xlLastCell).Row
                        iLastColumn = .Cells.SpecialCells(xlLastCell).Column
                        sCopyAddress = .Range(.Cells(iBeginRange.Row, iBeginRange.Column), .Cells(lLastrow, iLastColumn)).Address
                    Case Else
                        sCopyAddress = iBeginRange.Address
                        lLastrow = iBeginRange.Rows.Count
                        iLastColumn = iBeginRange.Columns.Count
                    End Select
                    lLastRowMyBook = wsDataSheet.Cells.SpecialCells(xlLastCell).Row + 1
                    sRngAddress = .Range(.Cells(lLastRowMyBook, 1), .Cells(lLastRowMyBook + lLastrow, iLastColumn)).Address
                    .Range(sCopyAddress).Copy wsDataSheet.Range(sRngAddress)
                End With
            End If
NEXT_:
        Next wsSh
        If bPolyBooks Then Workbooks(oAwb).Close False
    Next li
    With Application
        .ScreenUpdating = True: .EnableEvents = True: .Calculation = lCalc
    End With
End Sub

Option Explicit
Sub Consolidated_Range_of_Books_and_Sheets()
    Dim iBeginRange As Object, lCalc As Long
    Dim sRngAddress As String, oAwb As String, sCopyAddress As String, sSheetName As String
    Dim lLastrow As Long, lLastRowMyBook As Long, li As Long, iLastColumn As Integer
    Dim wsSh As Object, wsDataSheet As Object, bPolyBooks As Boolean, avFiles
    On Error Resume Next
    Set iBeginRange = Application.InputBox("Выберите диапазон сбора данных." & vbCrLf & _
                                           "1. При выборе только одной ячейки данные будут собраны со всех листов начиная с этой ячейки. " & _
                                           vbCrLf & "2. При выделении нескольких ячеек данные будут собраны только с указанного диапазона всех листов.", Type:=8)
    If iBeginRange Is Nothing Then Exit Sub
    sSheetName = InputBox("Введите имя листа, с которого собирать данные(если не указан, то данные собираются со всех листов)", "Параметр")
    If sSheetName = "" Then sSheetName = "*"
    On Error GoTo 0
    If MsgBox("Собрать данные с нескольких книг?", vbInformation + vbYesNo, "Excel-VBA") = vbYes Then
        avFiles = Application.GetOpenFilename("Excel files(*.xls*),*.xls*", , "Выбор файлов", , True)
        If VarType(avFiles) = vbBoolean Then Exit Sub
        bPolyBooks = True
    Else
        avFiles = Array(ThisWorkbook.FullName)
    End If
    With Application
        lCalc = .Calculation
        .ScreenUpdating = False: .EnableEvents = False: .Calculation = xlManual
    End With
    ThisWorkbook.Sheets.Add After:=Sheets(Sheets.Count)
    Set wsDataSheet = ThisWorkbook.ActiveSheet
    For li = LBound(avFiles) To UBound(avFiles)
        If bPolyBooks Then Workbooks.Open Filename:=avFiles(li)
        oAwb = Dir(avFiles(li), vbDirectory)
        For Each wsSh In Workbooks(oAwb).Sheets
            If wsSh.Name Like sSheetName Then
                If wsSh.Name = wsDataSheet.Name And bPolyBooks = False Then GoTo NEXT_
                With wsSh
                    Select Case iBeginRange.Count
                    Case 1
                        lLastrow = .Cells(1, 1).SpecialCells(xlLastCell).Row
                        iLastColumn = .Cells.SpecialCells(xlLastCell).Column
                        sCopyAddress = .Range(.Cells(iBeginRange.Row, iBeginRange.Column), .Cells(lLastrow, iLastColumn)).Address
                    Case Else
                        sCopyAddress = iBeginRange.Address
                        lLastrow = iBeginRange.Rows.Count
                        iLastColumn = iBeginRange.Columns.Count
                    End Select
                    lLastRowMyBook = wsDataSheet.Cells.SpecialCells(xlLastCell).Row + 1
                    sRngAddress = .Range(.Cells(lLastRowMyBook, 1), .Cells(lLastRowMyBook + lLastrow, iLastColumn)).Address
                    .Range(sCopyAddress).Copy wsDataSheet.Range(sRngAddress)
                End With
            End If
NEXT_:
        Next wsSh
        If bPolyBooks Then Workbooks(oAwb).Close False
    Next li
    With Application
        .ScreenUpdating = True: .EnableEvents = True: .Calculation = lCalc
    End With
End Sub

Просто вставьте приведенный выше текст в обычный модуль(про модули см.здесь) и потом макрос можно будет вызвать из этой книги, нажатием клавиш Alt+F8 и выбрав его, или создав на листе кнопку и назначив ей макрос. После вызова макроса надо будет указать диапазон сбора данных, имя листа, если необходимо(если не указан — данные будут собраны со всех листов) и выбрать книги для сбора данных.

Скачать пример »