Excel VBA: Opening Workbooks and Copying Cells - 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