Hogyan lehet végigpörgetni egy könyvtár fájljait és másolni az adatokat az Excel törzslapjába?

Feltéve, hogy egy mappában több Excel munkafüzet van, és szeretné végiggörgetni ezeket az Excel fájlokat, és adatokat másolni az azonos nevű munkalapok meghatározott tartományából az Excel fő munkalapjába, mit tehet? Ez a cikk részletesen bemutatja az elérésének módját.

Húzza végig a könyvtár fájljait, és másolja az adatokat egy VBA kóddal ellátott törzslapra

Húzza végig a könyvtár fájljait, és másolja az adatokat egy VBA kóddal ellátott törzslapra

Ha az A1: D4 tartományban megadott adatokat át szeretné másolni egy adott mappában lévő munkafüzetek összes 1. lapjáról egy törzslapra, akkor tegye a következőket.

1. A munkafüzetben létrehoz egy fő munkalapot, nyomja meg a gombot más + F11 billentyűk megnyitásához Microsoft Visual Basic for Applications ablak.

2. Ban,-ben Microsoft Visual Basic for Applications ablakban kattintson betétlap > Modulok. Ezután másolja a VBA kód alatt a kód ablakba.

VBA kód: egy mappában lévő fájlok közötti áttekintés és az adatok másolása egy törzslapra

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

Megjegyzések:

3. megnyomni a F5 gombot a kód futtatásához.

4. A nyílásban Tallózás ablakban, válassza ki a mappát, amely tartalmazza azokat a fájlokat, amelyeken keresztül végighúzza, majd kattintson a gombra OK gomb. Lásd a képernyőképet:

Ezután létrehoz egy „Új lap” nevű fő munkalapot az aktuális munkafüzet végén. A kiválasztott mappában található összes 1. lap D4 tartományának adatai pedig a munkalapon vannak felsorolva.

Kapcsolódó cikkek:

• Hogyan másoljuk a cellák adatait sormagassággal és oszlopszélességgel az Excel programban?