Excel VBA Copy/Paste Between Range of Workbooks

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, ie 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