Как пройтись по книгам в каталоге и скопировать данные в основной лист в Excel?

Предположим, у вас есть несколько книг Excel в папке, и вам нужно пройтись по всем этим файлам, чтобы скопировать данные из определённого диапазона на постоянном листе (например, Лист1) в основной лист. Это руководство предоставляет подробное решение с использованием VBA для автоматизации этого процесса в Excel.

Пройдитесь по книгам в каталоге и скопируйте данные в основной лист с помощью кода VBA

Пройдитесь по файлам в каталоге и скопируйте данные в основной лист с помощью кода VBA

Если вы хотите скопировать данные из диапазона A1:D4 во всех листах «Лист1» книг в определённой папке и вставить их в основной лист, выполните следующие действия.

1. В книге, где вы создадите основной лист, нажмите клавиши Alt + F11, чтобы открыть окно Microsoft Visual Basic for Applications.

2. В окне Microsoft Visual Basic for Applications нажмите Вставить > Модуль. Затем скопируйте приведённый ниже код VBA в окно кода.

Код VBA: пройдитесь по файлам в папке и скопируйте данные в основной лист

Sub Merge2MultiSheets()
    Dim xRg As Range
    Dim xSelItem As Variant
    Dim xFileDlg As FileDialog
    Dim xFileName, xSheetName, xRgStr As String
    Dim xBook, xWorkBook As Workbook
    Dim xSheet As Worksheet
    On Error Resume Next
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    xSheetName = "Sheet1"
    xRgStr = "A1:D4"
    Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    With xFileDlg
        If .Show = -1 Then
            xSelItem = .SelectedItems.Item(1)
            Set xWorkBook = ThisWorkbook
            Set xSheet = xWorkBook.Sheets("New Sheet")
            If xSheet Is Nothing Then
                xWorkBook.Sheets.Add(after:=xWorkBook.Worksheets(xWorkBook.Worksheets.Count)).Name = "New Sheet"
                Set xSheet = xWorkBook.Sheets("New Sheet")
            End If
            xFileName = Dir(xSelItem & "\*.xlsx", vbNormal)
            If xFileName = "" Then Exit Sub
            Do Until xFileName = ""
               Set xBook = Workbooks.Open(xSelItem & "\" & xFileName)
                Set xRg = xBook.Worksheets(xSheetName).Range(xRgStr)
                xRg.Copy xSheet.Range("A65536").End(xlUp).Offset(1, 0)
                xFileName = Dir()
                xBook.Close
            Loop
        End If
    End With
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Примечание:

3. Нажмите клавишу F5, чтобы запустить код.

4. В открывшемся окне Обзор выберите папку, содержащую файлы, по которым вы будете проходиться, а затем нажмите кнопку ОК. См. скриншот:

Основной лист под названием «Новый лист» создаётся в конце текущей книги. И данные из диапазона A1:D4 всех Листов1 в выбранной папке перечислены внутри этого листа.

Связанные статьи:

• Как скопировать данные ячеек вместе с высотой строки и шириной столбца в Excel?