Excel VBA：打开工作簿并复制单元格

Question

下面的宏从列表中打开一系列工作簿，然后从中复制一些数据。 它在第一个工作簿上正常工作，然后在第二个工作簿上崩溃。 我尝试过更改顺序，它始终是导致其崩溃的第二个工作簿。

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

Answer 1

我猜你的错误在这里：

 Workbooks.Open Filename:=ThisWorkbook.Path & "\\Analysis\\" & Cells(k, 1), UpdateLinks:=False 'Ooops ^^^^^ 

该.Activate和.Select呼叫进行卷积足够，我不是真的要花费精力搞清楚什么应该是在你的代码通过循环第二次运行特定点活动工作表。 不管它是什么，它都与您开始时不同，并且对Cells的无条件调用隐式地引用了当时是ActiveSheet任何工作表。 这将生成错误的文件名（或完全失败），然后滚轮脱落。

最好的办法是根本不使用Active*对象。 获取对您正在使用的对象的引用，然后使用它们。 这样，您就不会有电线交叉的可能性。 在查看时，您可以给他们命名，使您一眼就能清楚地看到正在使用的内容。

在获得不使用Activate和Select的代码之前，请结合其他因素。

---

lastSumRow是从来没有使用过lastUsedRow从未声明。 我假设他们应该是同一回事。 您应该将Option Explicit放在模块的顶部，以避免此类错误（甚至更糟）。

---

这两行代码在一起几乎没有什么意义：

  For j = 3 To 100 If j Mod 3 = 0 Then 

如果您只想复制每第3行，请跳过所有除法，仅以3 Step递增循环计数器：

        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创建一个无限循环。

---

您无需使用以下代码重复查找要复制到的工作表的最后一行：

 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应该是什么，因此我只是将其命名为存储在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