Hvordan går jeg igennem filer i et bibliotek og kopierer data til et masterark i Excel?
Antag at der er flere Excel-projektmapper i en mappe, og du vil løbe igennem alle disse Excel-filer og kopiere data fra det angivne område med samme navnearkeark til et hovedark i Excel, hvad kan du gøre? Denne artikel introducerer en metode til at opnå det i detaljer.
Loop gennem filer i et bibliotek, og kopier data til et masterark med VBA-kode
Loop gennem filer i et bibliotek, og kopier data til et masterark med VBA-kode
Hvis du vil kopiere angivne data i området A1: D4 fra alle ark1 med projektmapper i en bestemt mappe til et hovedark, skal du gøre som følger.
1. I projektmappen opretter du et hovedark, tryk på andre + F11 nøgler til at åbne Microsoft Visual Basic til applikationer vindue.
2. i Microsoft Visual Basic til applikationer vindue, skal du klikke på indsatte > Moduler. Kopier derefter under VBA-koden i kodevinduet.
VBA-kode: løb gennem filer i en mappe og kopier data til et masterark
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
Bemærk:
3. Tryk på F5 nøgle for at køre koden.
4. I åbningen Gennemse vindue, skal du vælge den mappe, der indeholder de filer, du vil løbe igennem, og derefter klikke på OK knap. Se skærmbillede:
Derefter oprettes et hovedark med navnet "Nyt ark" i slutningen af den aktuelle projektmappe. Og data i rækkevidde A1: D4 for alt ark1 i den valgte mappe er angivet inde i regnearket.
Relaterede artikler:
Bedste kontorproduktivitetsværktøjer
Overlad dine Excel-færdigheder med Kutools til Excel, og oplev effektivitet som aldrig før. Kutools til Excel tilbyder over 300 avancerede funktioner for at øge produktiviteten og spare tid. Klik her for at få den funktion, du har mest brug for...
Fanen Office bringer en grænseflade til et kontor med Office, og gør dit arbejde meget lettere
- Aktiver redigering og læsning af faner i Word, Excel, PowerPoint, Publisher, Access, Visio og Project.
- Åbn og opret flere dokumenter i nye faner i det samme vindue snarere end i nye vinduer.
- Øger din produktivitet med 50 % og reducerer hundredvis af museklik for dig hver dag!