Question

每当我运行此代码时，我得到：运行时错误＆＃39; 9＆＃39;下标超出范围。无法弄清楚如何解决此错误，请帮忙。代码通过选定文件夹中的excel文件运行，并复制粘贴选定的行。在下一步中，我想扩展代码，以存储和求和每个单元格值，如下所示： var1 = var1 + range（＆＃34; A5＆＃34;）。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，不包括括号。

我仔细研究了代码，看来你并没有明确地定义哪些书在每种情况下都是哪种，这意味着＆＃34;孤儿＆＃34;范围陈述可能会导致您的问题。 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语句中

从多个excel文件中抓取数据并将其复制到摘要表中

1 个答案: