Excel VBA Copy/Paste Between Range of Workbooks - excel

Question

I used to code in VBA frequently, but its been a few years and I am stumped. Have an issue with the following code that seems to work fine (although very slowly) for the first 9 files it is opening / copying from, then I get a macro error and it results in an excel hang-up requiring restart. I borrowed / modified heavily an earlier post from luke_t on this forum to get this far. As far as I can tell, there is no difference in the 9th file as they are all based on a standard template, but the error could be there?
Sub copy_rng()
Dim wb As Workbook, wbDest As Workbook, ws As Worksheet, wsDest As Worksheet, wsSrc As Worksheet
Dim wbNames() As Variant
Dim destPath As String
Dim fullpath As String
Dim outputrow As Variant, i As Byte
Set wb = ThisWorkbook
Set ws = wb.Sheets("Casing")
Set wsSrc = wb.Sheets("Casing")
wbNames = ws.Range("b5:b" & lrow(2, ws))
destPath = "C:\Users\...\Daily Reports\"
outputrow = 5
Application.ScreenUpdating = False
For i = 1 To UBound(wbNames, 1)
fullpath = destPath & wbNames(i, 1)
MsgBox i & " " & fullpath
'Stop
Set wbDest = Workbooks.Open(destPath & wbNames(i, 1))
Set wsDest = wbDest.Sheets("Field Report (Internal)")
With wsDest
.Range(Cells(27, 17), Cells(27, 19)).Copy
End With
wsSrc.Cells(outputrow, 10).PasteSpecial xlPasteValues
With wsDest
.Range(Cells(28, 17), Cells(28, 19)).Copy
End With
wsSrc.Cells(outputrow, 13).PasteSpecial xlPasteValues
With wsDest
.Range(Cells(29, 17), Cells(29, 19)).Copy
End With
wsSrc.Cells(outputrow, 16).PasteSpecial xlPasteValues
Application.CutCopyMode = False
wbDest.Close False
outputrow = outputrow + 1
Next i
Application.ScreenUpdating = True
End Sub
Function lrow(ByVal col_num As Integer, sheet_name As Worksheet) As Long
lrow = sheet_name.Cells(Rows.Count, col_num).End(xlUp).Row
End Function

Answer 1

Ok, finally figured this one out. Cleaned the code up to make it clearer, but I believe my issue was not in the code specifically, but rather in the fact that I did not have files created yet for some of the date based information I was trying to pull, i.e. I had dates for files to be created in the future and no error checking to see if those files existed. I haven't added the error checking, rather I just deleted the future date references for now as that was faster.
Sub copy_rng()
Dim wb As Workbook, wbToOpen As Workbook, ws As Worksheet, wsSource As Worksheet
Dim wbNames() As Variant
Dim filePath As String
Dim outputrow As Variant, i As Byte
Dim srcOneRange As Range, srcTwoRange As Range, srcThreeRange As Range
Set wb = ThisWorkbook
Set ws = wb.Sheets("Casing")
wbNames = ws.Range("b5:b" & lrow(2, ws))
filePath = "C:\Users\...\Daily Reports\" 'set path to your path
outputrow = 5
For i = 1 To UBound(wbNames, 1)
Application.ScreenUpdating = False
Set wbToOpen = Workbooks.Open(filePath & wbNames(i, 1))
Set wsSource = wbToOpen.Sheets("Field Report (Internal)")
Set srcOneRange = wsSource.Range("q27:s27")
Set srcTwoRange = wsSource.Range("q28:s28")
Set srcThreeRange = wsSource.Range("q29:s29")
ws.Activate
With ws
.Range(Cells(outputrow, 10), Cells(outputrow, 12)).Value = srcOneRange.Cells.Value
.Range(Cells(outputrow, 13), Cells(outputrow, 15)).Value = srcTwoRange.Cells.Value
.Range(Cells(outputrow, 16), Cells(outputrow, 18)).Value = srcThreeRange.Cells.Value
End With
wbToOpen.Close False
outputrow = outputrow + 1
Application.ScreenUpdating = True
DoEvents
ActiveWindow.SmallScroll down:=1
Application.WindowState = Application.WindowState
Next i
Application.ScreenUpdating = True
End Sub