Excel / VBA：如何从多个Excel文件复制数据

我想遍历文件夹中的所有Excel文件，以便对每个文件执行一些操作（所有文件的布局和Sheet1数据都是相同的）。

到目前为止，我有下面的代码给我一个特定文件夹中的Excel文件列表。 我无法弄清楚自己是如何从每个文件复制数据 – 具体而言， 我需要从每个文件中复制范围A10：E50中的数据，然后将其粘贴到当前文件中的页面上 （全部在下面）。

有人可以帮我弄这个吗 ？

我目前的代码：

 Sub FindFiles() Dim objFSO As Object Dim objFolder As Object Dim objFile As Object Dim ws As Worksheet Set objFSO = CreateObject("Scripting.FileSystemObject") Set ws = Worksheets.Add Set objFolder = objFSO.GetFolder("C:\Users\mo\Desktop\Test-Import\") 'ws.Cells(1, 1).Value = "The folder " & objFolder.Name & " contains the following Excel files:" For Each objFile In objFolder.Files ws.Cells(ws.UsedRange.Rows.Count + 1, 1).Value = objFile.Name Next Set objFolder = Nothing Set objFile = Nothing Set objFSO = Nothing End Sub 

非常感谢任何帮助，迈克

Answer 1

试试下面…

 Sub FindFiles() Dim objFSO As Object Dim objFolder As Object Dim objFile As File Dim ws As Worksheet Dim srWS As Worksheet Dim wb As Workbook Dim path As String Set objFSO = CreateObject("Scripting.FileSystemObject") path = " " 'Enter your path here Set objFolder = objFSO.GetFolder(path) 'ws.Cells(1, 1).Value = "The folder " & objFolder.Name & " contains the following Excel files:" Set ws = Worksheets.Add For Each objFile In objFolder.Files rowCount = ws.UsedRange.Rows.Count If (objFile.Type = "Microsoft Excel Worksheet" Or objFile.Type = "Microsoft Excel Macro-Enabled Worksheet") Then Set wb = Application.Workbooks.Open(path & objFile.Name) Set srWS = wb.Sheets(1) srWS.Range("A10:E50").Copy ws.Activate If rowCount = 1 Then ws.Cells(1, 1).Value = objFile.Name ws.Cells(rowCount + 1, 1).Select Else ws.Cells(rowCount + 1, 1).Value = objFile.Name ws.Cells(rowCount + 2, 1).Select End If ActiveSheet.Paste Application.DisplayAlerts = False wb.Close End If Next Application.DisplayAlerts = True Set objFolder = Nothing Set objFile = Nothing Set objFSO = Nothing End Sub 

Answer 2

尝试：

 Sub FindFiles() Dim objFolder As String, objFile As String, r As Integer, c As Integer 'r=row, c=column Dim ws As Worksheet Set ws = Worksheets.Add objFolder = "C:\Users\mo\Desktop\Test-Import\" objFile = Dir(objFolder) r = 10: c = 1 While objFile <> vbNullString And c < 6 ws.Cells(r, c).Value = objFile r = r + 1 If r = 51 Then r = 10 c = c + 1 End If objFile = Dir Wend End Sub 

注意这将只列出适合A10的文件数目：E50（200个文件）。 如果你有超过200个文件，macros将不包括它们。 你可以删除条件“And c <6”，如果你想看更多，或者编辑“r”值来列出更多行上的文件