Hoe bestanden in een directory doorlopen en gegevens naar een hoofdblad in Excel kopiëren?

Stel dat er meerdere Excel-werkmappen in een map staan ​​en u al deze Excel-bestanden wilt doorlopen en gegevens uit een opgegeven reeks werkbladen met dezelfde naam wilt kopiëren naar een hoofdwerkblad in Excel, wat kunt u dan doen? Dit artikel introduceert een methode om dit in detail te bereiken.

Loop door bestanden in een directory en kopieer gegevens naar een masterblad met VBA-code

Loop door bestanden in een directory en kopieer gegevens naar een masterblad met VBA-code

Als u gespecificeerde gegevens in bereik A1: D4 van alle werkbladen 1 in een bepaalde map naar een hoofdblad wilt kopiëren, doet u het volgende.

1. In de werkmap maakt u een hoofdwerkblad, druk op de anders + F11 toetsen om de te openen Microsoft Visual Basic voor toepassingen venster.

2. In de Microsoft Visual Basic voor toepassingen venster klikt Invoegen > Module. Kopieer vervolgens onderstaande VBA-code naar het codevenster.

VBA-code: loop door bestanden in een map en kopieer gegevens naar een hoofdblad

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

Note:

3. druk de F5 sleutel om de code uit te voeren.

4. In de opening Blader Selecteer de map met de bestanden die u wilt doorlopen en klik op het OK knop. Zie screenshot:

Vervolgens wordt aan het einde van de huidige werkmap een hoofdwerkblad met de naam "Nieuw blad" gemaakt. En gegevens in het bereik A1: D4 van alle Sheet1 in de geselecteerde map worden weergegeven in het werkblad.

Gerelateerde artikelen:

• Hoe celdata met rijhoogte en kolombreedte in Excel te kopiëren?