从多个Excel文件中抓取数据并将其复制到汇总表中

每当我运行这个代码，我得到：运行时错误'9'下标超出范围。 无法弄清楚如何解决这个错误，请帮助。 代码在选定的文件夹中运行excel文件，复制粘贴选定的行。 在下一步，我想扩展代码，存储和汇总每个单元格的值，如下所示：var1 = var1 + range（“A5”）。value但是，首先请帮助我如何解决这个错误。 谢谢。

Sub LoopAllExcelFilesInFolder() Dim OutputWs As Worksheet Dim myPath As String Dim myFile As String Dim myExtension As String Dim FldrPicker As FileDialog Dim Lastrow As Long 'Optimize Macro Speed Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual 'Retrieve Target Folder Path From User Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker) With FldrPicker .Title = "Select A Target Folder" .AllowMultiSelect = False If .Show <> -1 Then GoTo NextCode myPath = .SelectedItems(1) & "\" End With 'In Case of Cancel NextCode: myPath = myPath If myPath = "" Then GoTo ResetSettings 'Target File Extension myExtension = "*.xlsx" 'Target Path with Ending Extention myFile = Dir(myPath & myExtension) 'set output worksheet OutputWs = ThisWorkbook.Worksheets(Test) 'Loop through each Excel file in folder Do While myFile <> "" Workbooks.Open (myPath & myFile) Range("A1:D3").Copy ActiveWorkbook.Close Lastrow = OutputWs.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row ActiveSheet.Paste Destination:=Worksheets("Test").Range(Cells(Lastrow, 1), Cells(Lastrow, 4)) 'Get next file name myFile = Dir() Loop 'Message Box when tasks are completed MsgBox "Task Complete!" ResetSettings: 'Reset Macro Optimization Settings Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub 

Answer 1

要为工作表设置对象引用，需要包含关键字Set ：

 Set OutputWs = ThisWorkbook.Worksheets("yoursheetname") 

获取下一个文件名也应该是myFile = Dir ，不包括括号。

我仔细看了一下代码，看起来你并没有明确地定义在哪种情况下哪个书是“孤立的”范围语句会导致你的问题。 1004错误虽然是来自您的粘贴语句，我已经在下面的代码中更正：

 Sub LoopAllExcelFilesInFolder() Dim OutputWs As Worksheet Dim oNewBook As Workbook Dim myPath As String Dim myFile As String Dim myExtension As String Dim FldrPicker As FileDialog Dim Lastrow As Long 'Optimize Macro Speed Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual 'Retrieve Target Folder Path From User Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker) With FldrPicker .Title = "Select A Target Folder" .AllowMultiSelect = False If .Show <> -1 Then GoTo NextCode myPath = .SelectedItems(1) & "\" End With 'In Case of Cancel NextCode: myPath = myPath If myPath = "" Then GoTo ResetSettings 'Target File Extension myExtension = "*.xlsx" 'Target Path with Ending Extention myFile = Dir(myPath & myExtension) 'set output worksheet Set OutputWs = ThisWorkbook.Worksheets("Test") 'Loop through each Excel file in folder Do While myFile <> "" Set oNewBook = Workbooks.Open(myPath & myFile) oNewBook.Worksheets(1).Range("A1:D3").Copy oNewBook.Close Lastrow = OutputWs.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row With OutputWs Lastrow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row OutputWs.Paste .Range("A" & Lastrow & ":" & "D" & Lastrow) End With 'Get next file name myFile = Dir Loop 'Message Box when tasks are completed MsgBox "Task Complete!" ResetSettings: 'Reset Macro Optimization Settings Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub 

请注意，此代码假定您要从打开的工作簿的第一张工作表中复制（因此将oNewBook.Worksheets(1)添加到Range.Copy语句中）