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

那么你就不用担心＆＃34; displayalerts＆＃34;你必须测试它。

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

1 个答案: