Как пройтись по книгам в каталоге и скопировать данные в основной лист в 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 в выбранной папке перечислены внутри этого листа.
Связанные статьи:
Лучшие инструменты для повышения продуктивности в Office
Повысьте свои навыки работы в Excel с помощью Kutools для Excel и ощутите эффективность на новом уровне. Kutools для Excel предлагает более300 расширенных функций для повышения производительности и экономии времени. Нажмите здесь, чтобы выбрать функцию, которая вам нужнее всего...
Office Tab добавляет вкладки в Office и делает вашу работу намного проще
- Включите режим вкладок для редактирования и чтения в Word, Excel, PowerPoint, Publisher, Access, Visio и Project.
- Открывайте и создавайте несколько документов во вкладках одного окна вместо новых отдельных окон.
- Увеличьте свою продуктивность на50% и уменьшите количество щелчков мышью на сотни ежедневно!
Все надстройки Kutools. Один установщик
Пакет Kutools for Office включает надстройки для Excel, Word, Outlook и PowerPoint, а также Office Tab Pro — идеально для команд, работающих в разных приложениях Office.
- Комплексный набор — надстройки для Excel, Word, Outlook и PowerPoint плюс Office Tab Pro
- Один установщик, одна лицензия — настройка занимает считанные минуты (MSI-совместимо)
- Совместная работа — максимальная эффективность между приложениями Office
- 30-дневная полнофункциональная пробная версия — без регистрации и кредитной карты
- Лучшее соотношение цены и качества — экономия по сравнению с покупкой отдельных надстроек