在简单的VBA（打开文件，复制，粘贴，closures）过程中Excel崩溃在一个循环中

我是一名新的Excel 2013 vba程序员。 我已经编写了代码循环遍历文件夹中的每个文件，打开它，复制这些单元格，并粘贴到一个新文件，增加一行，然后为文件夹中的每个文件执行此操作。

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

这似乎运行良好，当我“通过”，但如果我只是F5的macros运行了一段时间，我看到它工作正常，然后部分通过它崩溃Excel“Excel已停止工作…”它只是closures。

你有没有遇到过这个？ 有什么build议么？ 以下是执行此工作的代码的子集：

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 

大家好，谢谢你的帮助。 随意build议我如何添加新的代码与额外的意见/问题 – 这对我来说是新的。
根据我的评论下面和你的build议我修改了代码。 我还没有尝试用Davesexcel的修复，但是当它不工作，昨天我做了一些挖掘，发现一个似乎工作，除了包括每个被复制的文件的标题行（行1）的CurrentRegion命令。 我发现的信息说，它假设一个标题行，不包括它，但似乎并没有发生。 这是我的新代码，非常感谢的build议。 另外，一个评论线 – 为什么不工作？ 它出错了。 我试图针对工作簿和工作表（总是工作簿中的第一个工作表，但名称各不相同），根据您指出的build议。 谢谢。

  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

可能是许多select，或范围被选中。

怎么样这样的事情，所以你不必使用select

 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 

那么你不必担心“displayalerts”，你将不得不testing它。