Excel 在循环中的简单 VBA（打开文件、复制、粘贴、关闭）期间崩溃

Question

我是一个新的 Excel 2013 vba 程序员。我编写了代码来遍历文件夹中的每个文件，打开它，复制单元格，然后粘贴到一个新文件，向下递增一行，然后对文件夹中的每个文件执行此操作。

在循环到下一个文件之前，我关闭了上一个文件。文件夹中有大约 120 个文件。这最终是在单个文件中创建文件夹中数据的索引。

当我“单步执行”时，这似乎运行良好，但是如果我只是 F5 宏，它会运行一段时间，我看到它运行良好，然后在中途它会崩溃 Excel“Excel 已停止工作......”它只是关闭。

你以前遇到过这种情况吗？有什么建议？这是完成工作的代码子集：

Sub WorkHorse()
    ' Application.DisplayAlerts = False 'large amount of data in clipboard, do you want to keep..." message_ *MUST TURN BACK ON SEE BELOW!!

    ChDir "R:\ISO\Sticks\307M"
    myFile = Dir("*.xlsx")


    Do Until myFile = ""
        Workbooks.Open Filename:=myFile
        If Range("A3") = "" Then
            Range("A2").Select
            Range(Selection, Selection.End(xlToRight)).Select
        End If
        If Range("A3") <> "" Then
            Range("A2").Select
            Range(Selection, Selection.End(xlToRight)).Select
            Range(Selection, Selection.End(xlDown)).Select
        End If
        Selection.Copy
        Windows("Test for Possanza Aug 2015.xlsm").Activate
        ActiveSheet.Paste
        Range("A1").Select
        ActiveSheet.Range("A1").Copy
        Selection.End(xlDown).Select
        ActiveCell.Offset(1, 0).Range("a1").Select
        Windows(myFile).Close
        myFile = Dir
    Loop

    ' Application.DisplayAlerts = True 'this re-enables Display Alerts in MSOffice. *CRITICAL TO TURN BACK ON!

End Sub

大家好，感谢您的帮助。请随时就如何添加带有其他注释/问题的新代码向我提供建议——这对我来说是新的。
根据我下面的评论和您的建议，我修改了代码。我还没有用 Davesexcel 的修复程序尝试过它，但是当它昨天不起作用时，我做了一些挖掘，发现了一个 CurrentRegion 命令，它似乎可以工作，但它包含每个正在复制的文件的标题行（第 1 行）。我发现的信息说它假设了一个标题行并且不包括它，但这似乎没有发生。这是我的新代码，非常感谢建议。另外，一条评论行 - 为什么这不起作用？它出错了。根据您向我提出的建议，我试图具体说明工作簿和工作表（始终是工作簿中的第一个工作表，但名称各不相同）。谢谢。

   Sub ReDoWorkHorseWithoutSelect()
    Dim myfile As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim DataBlock As Range

    Set wb = Workbooks("Test for Possanza Aug 2015.xlsm")
    Set ws = wb.Sheets("Sheet1")    'change desired sheet

    ChDir "R:\ISO\Sticks\307M"
    myfile = Dir("*.xlsx")

    Do Until myfile = ""
        Workbooks.Open Filename:=myfile
'       Set DataBlock = Workbooks("myfile").Worksheets(1).Range("A1").CurrentRegion
        Set DataBlock = Range("A2").CurrentRegion
        DataBlock.Copy ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1)
        Windows(myfile).Close
        myfile = Dir
    Loop

Answer 1

可能是许多选择，或被选择的范围。

这样的事情怎么样，这样你就不必使用选择了

Dim wb As Workbook, ws As Worksheet
Dim rng2 As Range
Dim Crng As Range


Set wb = Workbooks("Test for Possanza Aug 2015.xlsm")
Set ws = wb.Sheets("Sheet1")    'change desired sheet

'other code


Do Until myFile = ""
    Workbooks.Open Filename:=myFile
    Set rng2 = Range("A2")
    If rng2 = "" Then
        Set Crng = Range(rng2, rng2.End(xlToRight))
    Else
        r = Cells(Rows.Count, "A").End(xlUp).Row
        c = Cells(2, Columns.Count).End(xlToRight).Column
        Set Crng = Range(Cells(2, 1), Cells(r, c))
    End If

    Crng.Copy ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1)


    Windows(myFile).Close
    myFile = Dir
Loop

可能的用途

myfile.close true

那么您就不必担心“显示警报”，但您必须对其进行测试。