Vba Run-time error 9: Subscript out of range when copying a sheet between workbooks

Question

I am trying to copy a sheet from one workbook to another. The below code worked perfectly well when the name of the workbook and worksheet was hard-coded.

Instead when i tried to reference the sheet-name to be copied from a text in a cell, i am getting

Run-time error '9': Subscript out of range.

The error occurs in the Bold line. I tried the text with and without quotes (single and double both).

Sub copy_dss_data_1()
Dim wkbSource As Workbook
Dim wkbDest As Workbook
Dim shttocopy As Worksheet
Dim wbname As String

' check if the file is open (source file)
ret = Isworkbookopen(ThisWorkbook.Path & "\" & Range("J2"))
If ret = False Then
' open file
Set wkbSource = Workbooks.Open(ThisWorkbook.Path & "\" & Range("J2"))
Else
 Set wkbSource = Workbooks(Strings.Trim(Range("J2")))
 End If

' check if the file is open

ret = Isworkbookopen(ThisWorkbook.Path & "\Book1.xlsm")
If ret = False Then
' open file
Set wkbDest = Workbooks.Open(ThisWorkbook.Path & "\Book1.xlsm")
Else
 Set wkbDest = Workbooks("Book1.xlsm")
 End If

***Set shttocopy = wkbSource.Sheets(Strings.Trim(Range("J3")))
shttocopy.Copy wkbDest.Sheets(1)***

End Sub

Function Isworkbookopen(filename As String)
Dim ff As Long, ErrNo As Long
Dim wkb As Workbook
Dim nam As String

wbname = filename
On Error Resume Next

ff = FreeFile()
Open filename For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: Isworkbookopen = False
Case 70: Isworkbookopen = True
Case Else: Error ErrNo
End Select

End Function

You need to use `Range("J3")` otherwise this error is expected unless you have a worksheet literally named "J3". You should also be testing for whether sheet name exists... — David Zemens, Jul 19 '16 at 19:24
@DavidZemens: Hi david,I did try using range("J3"). But it was still showing the same error. Surprisingly when the source workbook was already open, it seem to work. But when the source is closed and has to be opened through the macro then the run-time error occurs. — Raj, Jul 19 '16 at 19:40
Yes, that's because opening the workbook changes which workbook is *Active* at runtime. — David Zemens, Jul 19 '16 at 20:11
@DavidZemens: But which workbook is currently active shouldn't affect the flow right? Because when the sheet is to copied from the source to destination, i have not used activeworkbook, I have reference the sheet using 'wkbSource.Sheets()'. So why would that cause a problem. I apologise if its a lame question, i am very new to vba. Just starting out. — Raj, Jul 19 '16 at 20:21
It *does* affect flow in this case because the `Range("J2")` isn't qualified to a specific workbook/worksheet, so Excel **always** assumes that this will be on the `ActiveSheet`. Whenever you are working with multiple sheets or multiple workbooks, it's imperative to fully qualify your objects like Ranges, Sheets, etc., otherwise you'll run in to these errors *constantly*. See [this](http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros) for primer. — David Zemens, Jul 19 '16 at 20:24

score 1 · Accepted Answer · answered Jul 19 '16 at 20:22

Try this. I've streamlined the code with some additional functions (GetWorkbook and SheetExists) to get rid of some redundancy. Also, assuming the values in J2/J3 are in the ThisWorkbook and on the active sheet, you need to capture these values to a variable before potentially opening other workbook(s), then, use the variables to pass the values:

Sub copy_dss_data_1()
    Dim wkbSource As Workbook
    Dim wkbDest As Workbook
    Dim shttocopy As Worksheet
    Dim wbname As String
    Dim shCopy$

    ' get sheet name & filename BEFORE opening any new file(s)
    wbName = Range("J2")
    shCopy = Range("J3")

    Set wkbSource = GetWorkbook(ThisWorkbook.Path, wbName)
    Set wkbDest = GetWorkbook(ThisWorkbook.Path, "Book1.xlsm")

    If SheetExists(wkbSource, shCopy) Then
        Set shttocopy = wkbSource.Sheets(Strings.Trim(shCopy))
        shttocopy.Copy wkbDest.Sheets(1)
    Else
        MsgBox shCopy & " doesn't exist in " & wkbSource.Name
    End If
End Sub
Function GetWorkbook(path$, name$)
' Returns the specified workbook&path
    If Isworkbookopen(path & "\" & name) Then
    ' open file
        Set GetWorkbook = Workbooks.Open(path & "\" & name)
    Else
        Set GetWorkbook = Workbooks(Strings.Trim(name))
    End If
End Function
Function SheetExists(wb as Workbook, s$)
' checks if sheet exists in the wb
        ret = ""
        On Error Resume Next
        ret = wb.Sheets(s).Name
        SheetExists = ret <> ""
End Function
Function Isworkbookopen(filename As String)
    Dim ff As Long, ErrNo As Long
    Dim wkb As Workbook
    Dim nam As String

    wbname = filename
    On Error Resume Next

    ff = FreeFile()
    Open filename For Input Lock Read As #ff
    Close ff
    ErrNo = Err
    On Error GoTo 0
    Select Case ErrNo
        Case 0: Isworkbookopen = False
        Case 70: Isworkbookopen = True
        Case Else: Error ErrNo
    End Select

End Function

Thanks a lot. This code is great. Appreciate the time and effort. — Raj, Jul 19 '16 at 20:36

Vba Run-time error 9: Subscript out of range when copying a sheet between workbooks

1 Answers1