将工作表从另一个工作簿（＃2）导入到当前工作簿（＃1）

Question

I wrote a code that is opening a window in which I can select a the excel workbook (#2) I want to copy and import the worksheet from. The Code is then checking whether the wanted worksheet (named "Guidance") exists in the opened workbook (#2).If so it should be copied and pasted into the current workbook (#1). After pasting the worksheet the workbook (#2) should be closed again.

So far the code does what I want it to do, as it opens the window and lets me select the wanted worksheet (named "Guidance") but I have the bug (not sure if the translation is correct)

"Runtime error '9': index out of range"

where the worksheet is supposed to be copied and pasted.

Any help on that would be very much appreciated! Thanks in advance.

 Private Function SheetExists(sWSName As String, Optional InWorkbook As Workbook) As Boolean

 If InWorkbook Is Nothing Then
    Set InWorkbook = ThisWorkbook
 End If

 Dim ws As Worksheet
 On Error Resume Next
 Set ws = Worksheets(sWSName)
 If Not ws Is Nothing Then SheetExists = True

 On Error GoTo 0

 End Function


 Sub GuidanceImportieren()


 Dim sImportFile As String, sFile As String
 Dim sThisWB As Workbook
 Dim vFilename As Variant

 Application.ScreenUpdating = False
 Application.DisplayAlerts = False

 Set sThisWB = ActiveWorkbook
 sImportFile = Application.GetOpenFilename("Microsoft Excel Workbooks, 
 *xls; *xlsx; *xlsm")

 If sImportFile = "False" Then
 MsgBox ("No File Selected")
 Exit Sub

 Else
 vFilename = Split(sImportFile, "|")
 sFile = vFilename(UBound(vFilename))
 Application.Workbooks.Open (sImportFile)

 Set wbWB = Workbooks("sImportFile")
 With wbWB
 If SheetExists("Guidance") Then
 Set wsSht = .Sheets("Guidance")
 wsSht.Copy Before:=sThisWB.Sheets("Guidance")
 Else
 MsgBox ("No worksheet named Guidance")
 End If

 wbWB.Close SaveChanges:=False
 End With
 End If

 Application.ScreenUpdating = True
 Application.DisplayAlerts = True

 End Sub

Answer 1

The issue is here

Set wbWB = Worksheets("Guidance") '<-- this should be a workbook not a worksheet?
With wbWB '<-- this with is useless until …
    If SheetExists("Guidance") Then
        Set wsSht = .Sheets("Guidance") '<-- … until Sheets here starts with a dot
        wsSht.Copy Before:=sThisWB.Sheets("Guidance") 'if the error is here then there is no sheet "Guidance" in sThisWB
    Else
        MsgBox ("No worksheet named Guidance")
    End If
    wbWB.Close SaveChanges:=False
End With

Also note that SheetExists("Guidance") does not check in a specific workbook (which may fail). I recommend to extend the function to:

Private Function SheetExists(WorksheetName As String, Optional InWorkbook As Workbook) As Boolean
    If InWorkbook Is Nothing Then
        Set InWorkbook = ThisWorkbook 'fallback if not set
    End If

    Dim ws As Worksheet
    On Error Resume Next
    Set ws = InWorkbook.Worksheets(WorksheetName)
    SheetExists = Not ws Is Nothing
    On Error Goto 0 'necessary because the Err.Number will not be cleared on End Function
End Function

So you can test if a worksheet exists in a specific workbook like

SheetExists("Guidance", sThisWB)
SheetExists("Guidance", wbWB)

---

Sub GuidanceImportieren()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim sImportFile As String
    sImportFile = Application.GetOpenFilename("Microsoft Excel Workbooks, *xls; *xlsx; *xlsm")

    If sImportFile = False Then 'false should not be "false"
        MsgBox "No File Selected"
        Exit Sub
    Else
        Dim vFilename As Variant
        vFilename = Split(sImportFile, "|")

        Dim sFile As String
        sFile = vFilename(UBound(vFilename))

        Dim ImportWorkbook As Workbook
        Set ImportWorkbook = Application.Workbooks.Open(sImportFile)

        If SheetExists("Guidance", ImportWorkbook) Then
            ImportWorkbook.Sheets("Guidance").Copy Before:=ThisWorkbook.Sheets("Guidance")
            'you might need to change it into something like this:
        Else
            MsgBox "No worksheet named Guidance"
        End If

        ImportWorkbook.Close SaveChanges:=False
    End If

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub