Hur går man igenom filer i en katalog och kopierar data till ett huvudark i Excel?
Antag att det finns flera Excel-arbetsböcker i en mapp, och du vill slinga igenom alla dessa Excel-filer och kopiera data från angivet intervall med samma namn-kalkylblad till ett huvudark i Excel, vad kan du göra? Denna artikel introducerar en metod för att uppnå det i detalj.
Sök igenom filer i en katalog och kopiera data till ett huvudark med VBA-kod
Sök igenom filer i en katalog och kopiera data till ett huvudark med VBA-kod
Om du vill kopiera specificerad data i intervall A1: D4 från alla ark1 av arbetsböcker i en viss mapp till ett huvudark, gör så här.
1. I arbetsboken skapar du ett huvudark, tryck på andra + F11 nycklar för att öppna Microsoft Visual Basic för applikationer fönster.
2. I Microsoft Visual Basic för applikationer fönstret klickar Insert > Modulerna. Kopiera sedan VBA-koden nedan till kodfönstret.
VBA-kod: slinga igenom filer i en mapp och kopiera data till ett huvudark
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
Anmärkningar:
3. tryck på F5 för att köra koden.
4. I öppningen Bläddra välj mappen som innehåller filerna du kommer att gå igenom och klicka sedan på OK knapp. Se skärmdump:
Sedan skapas ett huvudkalkylblad med namnet "Nytt ark" i slutet av den nuvarande arbetsboken. Och data i intervall A1: D4 för alla ark 1 i vald mapp listas inuti kalkylbladet.
Relaterade artiklar:
Bästa kontorsproduktivitetsverktyg
Överlägsna dina Excel-kunskaper med Kutools for Excel, och upplev effektivitet som aldrig förr. Kutools for Excel Erbjuder över 300 avancerade funktioner för att öka produktiviteten och spara tid. Klicka här för att få den funktion du behöver mest...
Office Tab Ger gränssnitt med flikar till Office och gör ditt arbete mycket enklare
- Aktivera flikredigering och läsning i Word, Excel, PowerPoint, Publisher, Access, Visio och Project.
- Öppna och skapa flera dokument i nya flikar i samma fönster, snarare än i nya fönster.
- Ökar din produktivitet med 50 % och minskar hundratals musklick för dig varje dag!














