Excel 将工作表从其他工作簿（2）导入当前工作簿（1）

我编写了一段代码，打开了一个窗口，可以在其中选择要复制和导入工作表的excel工作簿2。 然后，代码将检查打开的工作簿2中是否存在名为Guidence的所需工作表。如果存在，则应将其复制并粘贴到当前工作簿1中。 粘贴工作表后，应再次关闭工作簿2

到目前为止，代码做了我希望它做的事情，因为它打开了窗口，让我选择想要的名为Guidence的工作表，但我有一个bug，不确定翻译是否正确

运行时错误“9”：索引超出范围

工作表的复制和粘贴位置

在此方面的任何帮助都将不胜感激！提前谢谢

 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

问题就在这里

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

因此，您可以测试特定工作簿中是否存在工作表，如

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

---

请注意：您应该添加一个On Error GoTo 0或Err。请在结束函数之前清除，否则在工作表不存在的情况下，Err将不会被清除。@Pᴇ谢谢你的提示！sThisWB是否已经有一个名为指南的工作表？因为Copy方法中使用的Before参数使用现有的工作表作为引用，所以如果工作表不存在，它就不能被引用。哦，我实际上删除了名为Guidance的工作表，前面的代码进行了检查，它是否存在，如果存在则将其删除。@HenriquePessoa如何将其插入当前工作簿的开头？谢谢！是的，我认为第一行应该是工作簿，我还添加了。在第4行的工作表前面。在我之前打开的窗口中选择的工作表中，有一张名为“指南”的工作表，因此我不明白为什么找不到它。@AnnavonBlohn请参阅我的编辑。可能您签入了错误的工作簿以确定工作表是否存在。我是否签入了刚才打开的工作表，方法是将sFile定义为上面两行中的当前工作簿？@AnnavonBlohn不一定。我不会相信的。永远不要让Excel猜到你指的是哪本工作簿。始终准确地指定工作簿和工作表，否则您永远无法确定会发生什么。

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