Как да преминете през файлове в директория и да копирате данни в главен лист в Excel?
Да предположим, че има няколко работни книги на Excel в папка и искате да преминете през всички тези файлове на Excel и да копирате данни от определен диапазон от работни листове със същото име в главен работен лист в Excel, какво можете да направите? Тази статия представя в детайли метод за постигането му.
Преглеждайте файлове в директория и копирайте данни в главен лист с VBA код
Преглеждайте файлове в директория и копирайте данни в главен лист с VBA код
Ако искате да копирате определени данни в диапазон A1:D4 от всички sheet1 на работни книги в определена папка в главен лист, моля, направете следното.
1. В работната книга ще създадете главен работен лист, натиснете Друг + F11 за да отворите Microsoft Visual Basic за приложения прозорец.
2. В Microsoft Visual Basic за приложения прозорец, кликнете Поставете > Модули. След това копирайте по-долу 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. В откриването паса прозорец, моля, изберете папката, която съдържа файловете, през които ще преминете, и след това щракнете върху OK бутон. Вижте екранна снимка:
След това в края на текущата работна книга се създава главен работен лист с име „Нов лист“. И данните в диапазон A1:D4 на всички Sheet1 в избраната папка са изброени в работния лист.
Още по темата:
Най-добрите инструменти за продуктивност в офиса
Усъвършенствайте уменията си за Excel с Kutools за Excel и изпитайте ефективност, както никога досега. Kutools за Excel предлага над 300 разширени функции за повишаване на производителността и спестяване на време. Щракнете тук, за да получите функцията, от която се нуждаете най-много...
Раздел Office Внася интерфейс с раздели в Office и прави работата ви много по-лесна
- Разрешете редактиране и четене с раздели в Word, Excel, PowerPoint, Publisher, Access, Visio и Project.
- Отваряйте и създавайте множество документи в нови раздели на един и същ прозорец, а не в нови прозорци.
- Увеличава вашата производителност с 50% и намалява стотици кликвания на мишката за вас всеки ден!