Excel VBA：打开工作簿和复制单元格
下面的macros从列表中打开一系列工作簿，然后从中复制一些数据。 它适用于第一个工作簿，然后在第二个崩溃。 我试过改变顺序，并且总是第二个工作簿导致它崩溃。
Sub ImportData() Dim lastRow As Long Dim lastSumRow As Long Dim j As Long Dim k As Long With ActiveSheet lastRow = ActiveSheet.Cells(1048576, 1).End(xlUp).Row End With For k = 2 To lastRow k = 2 lastUsedRow = ThisWorkbook.Sheets("Summary").Cells(1048576, 1).End(xlUp).Row If ActiveSheet.Cells(k, 2).Value <> "Imported" Then Workbooks.Open Filename:=ThisWorkbook.Path & "\Analysis\" & Cells(k, 1), UpdateLinks:=False ActiveWorkbook.Sheets("Summary").Activate For j = 3 To 100 If j Mod 3 = 0 Then ThisWorkbook.Sheets("Summary").Cells((j / 3) + lastUsedRow, 1).Value = ActiveWorkbook.Sheets("Summary").Cells(j, 1).Value ThisWorkbook.Sheets("Summary").Cells((j / 3) + lastUsedRow, 2).Value = ActiveWorkbook.Sheets("Summary").Cells(j + 1, 2).Value ThisWorkbook.Sheets("Summary").Cells((j / 3) + lastUsedRow, 3).Value = ActiveWorkbook.Sheets("Summary").Cells(j + 1, 3).Value ThisWorkbook.Sheets("Summary").Cells((j / 3) + lastUsedRow, 4).Value = ActiveWorkbook.Sheets("Summary").Cells(j + 1, 4).Value ThisWorkbook.Sheets("Summary").Cells((j / 3) + lastUsedRow, 5).Value = ActiveWorkbook.Sheets("Summary").Cells(j + 2, 2).Value ThisWorkbook.Sheets("Summary").Cells((j / 3) + lastUsedRow, 6).Value = ActiveWorkbook.Sheets("Summary").Cells(j + 2, 3).Value ThisWorkbook.Sheets("Summary").Cells((j / 3) + lastUsedRow, 7).Value = ActiveWorkbook.Sheets("Summary").Cells(j + 2, 4).Value ThisWorkbook.Sheets("Summary").Cells((j / 3) + lastUsedRow, 8).Value = ActiveWorkbook.Sheets("Summary").Cells(j + 1, 5).Value End If Next j ActiveWorkbook.Close End If ThisWorkbook.Sheets("Setup").Cells(k, 2).Value = "Imported" Next k End Sub 我猜你的错误在这里：
Workbooks.Open Filename:=ThisWorkbook.Path & "\Analysis\" & Cells(k, 1), UpdateLinks:=False 'Ooops ^^^^^
.Activate和.Select调用是非常复杂的，所以我不会花费大量的精力来搞清楚在循环的第二次运行中代码中特定位置的活动工作表。 无论如何，它与开始时的不同，并且对Cells的非限定调用隐式引用当时的任何工作表是ActiveSheet 。 这会生成一个错误的文件名（或完全失败），然后轮子脱落。
最好的办法是根本不使用Active*对象。 获取您正在使用的对象的引用，以及使用它们。 这样就不会有电线穿过。 当你处于这个状态时，你可以给他们一个明确的名字，让你知道你在做什么。
在我们find不使用“ Activate和“ Select的代码之前，结合其他的东西。
lastSumRow永远不会被使用， lastUsedRow永远不会被声明。 我假设他们应该是一样的东西。 您应该将Option Explicit放在模块的顶部，以避免这种types的错误（以及更糟的错误）。
这两行代码在一起意义不大：
For j = 3 To 100 If j Mod 3 = 0 Then
如果你只想复制每一行的第三行，跳过所有的部门，只是增加你的循环计数器的Step 3：
For j = 3 To 99 Step 3
请注意，您可以在99停止，因为100 Mod 3永远不会是0 。
您的With块在这里不使用捕获的参考…
With ActiveSheet lastRow = ActiveSheet.Cells(1048576, 1).End(xlUp).Row End With
…但是你不断的使用这个模式，这在With块中是有用的 ：
ThisWorkbook.Sheets("Summary").Cells((j / 3) + lastUsedRow, 1).Value = ... ThisWorkbook.Sheets("Summary").Cells((j / 3) + lastUsedRow, 2).Value = ... ThisWorkbook.Sheets("Summary").Cells((j / 3) + lastUsedRow, 3).Value = ...
硬编码Cells(1048576, 1)将在旧版本的Excel上失败。 您应该使用Rows.Count来代替。
正如在评论中提到的， k = 2创build了一个无限循环。
您不需要使用此代码重复查找要复制到的工作表的最后一行：
lastUsedRow = ThisWorkbook.Sheets("Summary").Cells(1048576, 1).End(xlUp).Row
每次你通过你的“ j ”循环，最后一行增加一个。 只需加1到lastUsedRow而不是做所有的行计算体操。
如果您正在使用Worksheets ，请使用Worksheets集合而不是Sheets集合：
ThisWorkbook.Sheets("Summary") '<--I could return a Chart!
把所有这些放在一起，然后你想出下面的代码。 请注意，我不知道什么ActiveSheet应该是当你启动这个macros，所以我刚刚命名variables存储在active 。 这很有可能是其他工作表中的其中一个（我不知道） – 如果是的话，你应该把它们合并成一个引用：
Public Sub ImportData() Dim lastRow As Long Dim lastUsedRow As Long Dim dataRow As Long Dim fileNameRow As Long Dim active As Worksheet Set active = ActiveSheet With active lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row End With Dim setupSheet As Worksheet Set setupSheet = ThisWorkbook.Worksheets("Setup") With ThisWorkbook.Worksheets("Summary") lastUsedRow = .Cells(.Rows.Count, 1).End(xlUp).Row For fileNameRow = 2 To lastRow If active.Cells(fileNameRow, 2).Value <> "Imported" Then Dim source As Workbook Set source = Workbooks.Open(ThisWorkbook.Path & "\Analysis\" & _ active.Cells(fileNameRow, 1), False) Dim dataSheet As Worksheet Set dataSheet = source.Worksheets("Summary") For dataRow = 3 To 99 Step 3 .Cells(lastUsedRow, 1).Value = dataSheet.Cells(dataRow, 1).Value .Cells(lastUsedRow, 2).Value = dataSheet.Cells(dataRow + 1, 2).Value .Cells(lastUsedRow, 3).Value = dataSheet.Cells(dataRow + 1, 3).Value .Cells(lastUsedRow, 4).Value = dataSheet.Cells(dataRow + 1, 4).Value .Cells(lastUsedRow, 5).Value = dataSheet.Cells(dataRow + 2, 2).Value .Cells(lastUsedRow, 6).Value = dataSheet.Cells(dataRow + 2, 3).Value .Cells(lastUsedRow, 7).Value = dataSheet.Cells(dataRow + 2, 4).Value .Cells(lastUsedRow, 8).Value = dataSheet.Cells(dataRow + 1, 5).Value lastUsedRow = lastUsedRow + 1 Next source.Close End If setupSheet.Cells(fileNameRow, 2).Value = "Imported" Next End With End Sub