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

Question

The macro below opens a series of workbooks from a list, then copies some data from them. It works fine for the first workbook, then crashes on the second. I've tried changing the order, and it's always the second workbook that causes it to crash.

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

I'm guessing your error is here:

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

The .Activate and .Select calls are convoluted enough that I'm not really going to expend the effort figuring out what should be the active worksheet at that particular point in your code on the second run through the loop. Whatever it is, it's different than it was when you started and an unqualified call to Cells implicitly refers to whatever worksheet is the ActiveSheet at the time. This builds a bad file name (or fails completely) and then the wheels come off.

The best thing to do is not use the Active* objects at all. Get references to the objects that you're using, and well, use them. That way there is no chance that you'll get wires crossed. While you're at it, you can give them names that make it obvious what you're working with at a glance.

Couple other things before we get to the code that doesn't use Activate and Select .

---

lastSumRow is never used and lastUsedRow is never declared. I'm assuming they were supposed to be the same thing. You should put Option Explicit at the top of your modules to avoid this type of error (and worse ones).

---

These 2 lines of code make very little sense together:

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

If you only want to copy every 3rd row, skip all the division and just increment your loop counter with a Step of 3:

        For j = 3 To 99 Step 3

Note that you can stop at 99, because 100 Mod 3 is never going to be 0 .

---

Your With block here isn't using the captured reference...

 With ActiveSheet lastRow = ActiveSheet.Cells(1048576, 1).End(xlUp).Row End With 

...but you continually use this pattern that would be useful in a With block:

 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 = ... 

---

Hard-coding Cells(1048576, 1) will fail on older versions of Excel. You should use Rows.Count instead.

---

As mentioned in the comments, k = 2 creates an infinite loop.

---

You don't need to repeatedly find the last row of the sheet you're copying to with this code:

 lastUsedRow = ThisWorkbook.Sheets("Summary").Cells(1048576, 1).End(xlUp).Row 

Each time you go through your " j " loop, the last row increases by one. Just add 1 to lastUsedRow instead of doing all the row counting gymnastics.

---

If you're working with Worksheets , use the Worksheets collection instead of the Sheets collection:

 ThisWorkbook.Sheets("Summary") '<--I could return a Chart! 

---

Put all of that together, and you come up with something like the code below. Note that I have no clue what the ActiveSheet is supposed to be when you start this macro, so I just named the variable it's stored in active . It's quite possible that it's one of the other worksheets it grabs a reference too (I have no clue) - if so, you should consolidate them into one reference:

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