Kako se vrteti po datotekah v imeniku in kopirati podatke v glavni list v Excelu?

Recimo, da je v mapi več Excelovih delovnih zvezkov in bi radi zavili vse te Excelove datoteke in kopirali podatke iz določenega obsega istoimenskih delovnih listov v glavni delovni list v Excelu, kaj lahko storite? Ta članek podrobno predstavlja metodo za njegovo doseganje.

Prelistajte datoteke v imeniku in kopirajte podatke v glavni list s kodo VBA

Prelistajte datoteke v imeniku in kopirajte podatke v glavni list s kodo VBA

Če želite kopirati določene podatke v obsegu A1: D4 iz vseh listov1 delovnih zvezkov v določeni mapi na glavni list, storite naslednje.

1. V delovnem zvezku boste ustvarili glavni delovni list, pritisnite druga + F11 tipke za odpiranje Microsoft Visual Basic za aplikacije okno.

2. V Ljubljani Microsoft Visual Basic za aplikacije okno, kliknite Vstavi > Moduli. Nato kopirajte spodnjo kodo VBA v okno s kodo.

Koda VBA: zavrtite datoteke v mapi in kopirajte podatke v glavni list

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

Opombe:

3. Pritisnite F5 tipko za zagon kode.

4. Na odprtju Brskanje v oknu izberite mapo, v kateri so datoteke, do katerih boste šli, in nato kliknite OK . Oglejte si posnetek zaslona:

Nato se na koncu trenutnega delovnega zvezka ustvari glavni delovni list z imenom »Nov list«. In podatki v obsegu A1: D4 vseh listov1 v izbrani mapi so navedeni na delovnem listu.

Sorodni članki:

• Kako kopirati podatke celic z višino vrstice in širino stolpca v Excelu?