VBA技术求助：导入指定工作表前校验存在性时报错

问题背景 #

• 2006年后未使用VBA，需实现从用户选择的源Excel文件向目标工作簿导入3个预定义工作表，具体要求：
  1. 校验必填工作表Cover e Legenda，存在则导入，否则报错退出；
  2. 分别校验Test Funzionali和Test Batch，存在则导入、不存在则提示，且至少存在其中一个才能继续；
• 原代码未加校验时可正常导入，但添加校验后仅能完成Cover e Legenda的导入，后续操作立即出现「缺失工作表」错误。

错误代码 #

Sub Import()

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim TargetWorkbook As Workbook
    Dim SourceWorkbook As Workbook
    Dim OpenFileName

    Set TargetWorestBookkbook = ActiveWorkbook


    'Select and Open Source workbook
    OpenFileName = Application.GetOpenFilename("Excel Files (*.xls*),*.xls*")
        
    If OpenFileName = False Then
        MsgBox "Nessun file Source selezionato. Impossibile procedere."
        Exit Sub
    End If
        
    On Error GoTo exit_
    
    Set SourceWorkbook = Workbooks.Open(OpenFileName)
    
    'Import sheets
    ' if the sheet doesn't exist an error will occur here

        If WorksheetExists("Cover e Legenda") Then
            SourceWorkbook.Sheets("Cover e Legenda").Copy _
            after:=TargetWorkbook.Sheets(ThisWorkbook.Sheets.Count)
            Application.CutCopyMode = False
            SourceWorkbook.Close False
        Else
            MsgBox ("Cover assente. Impossibile proseguire.")
            Exit Sub
        End If

        If WorksheetExists("Test Funzionali") Then
            SourceWorkbook.Sheets("Test Funzionali").Copy _
            after:=TargetWorkbook.Sheets(ThisWorkbook.Sheets.Count)
            Application.CutCopyMode = False
            SourceWorkbook.Close False
        Else
            MsgBox ("Test Funzionali assente.")
        End If

        If WorksheetExists("Test Batch") Then
            SourceWorkbook.Sheets("Test Batch").Copy _
            after:=TargetWorkbook.Sheets(ThisWorkbook.Sheets.Count)
            Application.CutCopyMode = False
            SourceWorkbook.Close False
        Else
            MsgBox ("Test Batch assente.")
        End If

    'Next Sheet
            
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
            
    SourceWorkbook.Close SaveChanges:=False
    MsgBox ("Importazione completata.")

    TargetWorkbook.Activate
        

exit_:
        Application.ScreenUpdating = True
        Application.DisplayAlerts = True
        If Err Then MsgBox Err.Description, vbCritical, "Error"


End Sub

错误分析 #

1. 变量名拼写错误：TargetWorestBookkbook应为TargetWorkbook，导致后续引用目标工作簿时出错；
2. 过早关闭源工作簿：在导入第一个工作表后就执行SourceWorkbook.Close False，后续操作源工作簿时自然报错；
3. 未实现「至少存在一个可选工作表」的校验逻辑：原代码没有判断Test Funzionali和Test Batch是否至少存在一个；
4. WorksheetExists函数未定义：原代码中调用了该函数但未实现，会直接触发错误；
5. 工作表复制时的目标位置错误：TargetWorkbook.Sheets(ThisWorkbook.Sheets.Count)应该改为TargetWorkbook.Sheets(TargetWorkbook.Sheets.Count)，避免引用错误的工作簿。

修复后的代码 #

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

    Dim TargetWorkbook As Workbook
    Dim SourceWorkbook As Workbook
    Dim OpenFileName As Variant
    Dim hasOptionalSheet As Boolean
    
    ' 修正变量名拼写错误
    Set TargetWorkbook = ActiveWorkbook

    ' 选择并打开源工作簿
    OpenFileName = Application.GetOpenFilename("Excel Files (*.xls*),*.xls*")
    If OpenFileName = False Then
        MsgBox "Nessun file Source selezionato. Impossibile procedere."
        GoTo Cleanup
    End If
    
    On Error GoTo ErrorHandler
    Set SourceWorkbook = Workbooks.Open(OpenFileName)

    ' 校验并导入必填工作表Cover e Legenda
    If Not WorksheetExists(SourceWorkbook, "Cover e Legenda") Then
        MsgBox "Cover assente. Impossibile proseguire."
        GoTo Cleanup
    End If
    SourceWorkbook.Sheets("Cover e Legenda").Copy after:=TargetWorkbook.Sheets(TargetWorkbook.Sheets.Count)
    Application.CutCopyMode = False

    ' 校验并导入Test Funzionali
    hasOptionalSheet = False
    If WorksheetExists(SourceWorkbook, "Test Funzionali") Then
        SourceWorkbook.Sheets("Test Funzionali").Copy after:=TargetWorkbook.Sheets(TargetWorkbook.Sheets.Count)
        Application.CutCopyMode = False
        hasOptionalSheet = True
    Else
        MsgBox "Test Funzionali assente."
    End If

    ' 校验并导入Test Batch
    If WorksheetExists(SourceWorkbook, "Test Batch") Then
        SourceWorkbook.Sheets("Test Batch").Copy after:=TargetWorkbook.Sheets(TargetWorkbook.Sheets.Count)
        Application.CutCopyMode = False
        hasOptionalSheet = True
    Else
        MsgBox "Test Batch assente."
    End If

    ' 校验是否至少存在一个可选工作表
    If Not hasOptionalSheet Then
        MsgBox "Nessun foglio opzionale presente (Test Funzionali/Test Batch). Impossibile proseguire."
        GoTo Cleanup
    End If

    MsgBox "Importazione completata."

Cleanup:
    ' 统一关闭源工作簿，避免重复关闭
    If Not SourceWorkbook Is Nothing Then
        SourceWorkbook.Close SaveChanges:=False
    End If
    TargetWorkbook.Activate
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Exit Sub

ErrorHandler:
    MsgBox Err.Description, vbCritical, "Error"
    GoTo Cleanup
End Sub

' 实现工作表存在性校验函数
Function WorksheetExists(wb As Workbook, sheetName As String) As Boolean
    Dim ws As Worksheet
    On Error Resume Next
    Set ws = wb.Sheets(sheetName)
    On Error GoTo 0
    WorksheetExists = Not ws Is Nothing
End Function

修复说明 #

• 修正了变量名拼写错误，确保目标工作簿引用正确；
• 将源工作簿关闭操作移至统一的Cleanup代码块，避免过早关闭；
• 新增hasOptionalSheet变量，实现「至少存在一个可选工作表」的校验逻辑；
• 实现了WorksheetExists函数，明确传入源工作簿参数，避免上下文混淆；
• 修正了工作表复制的目标位置，确保插入到目标工作簿的最后；
• 优化了错误处理流程，统一清理资源，提升代码健壮性。

内容的提问来源于stack exchange，提问作者Marco Olmedi