VBA导入数据：跳过不存在工作表避免宏运行中断

嘿，我来帮你搞定这个问题！你的宏现在遇到不存在的工作表就停止，核心原因是你直接硬编码访问每个工作表，一旦某个表不存在，VBA就会抛出运行时错误中断程序。下面我给你两种解决方案，同时还会优化你的代码，让它更简洁易维护。

问题根源 #

你当前的代码是逐个硬编码每个工作表名称（比如OriginSheet145 = "F(AE)"），然后直接调用Wb1.Sheets(OriginSheetXXX)，如果这个工作表不存在，VBA就会触发下标越界错误，导致宏直接停止。

解决方案1：使用错误捕获跳过不存在的工作表 #

我们可以把所有要处理的工作表名称放到一个数组里，然后循环处理每个名称，用On Error Resume Next捕获工作表不存在的错误，跳过不存在的表继续执行。

优化后的完整代码：

Sub ImportData()
    Dim Wb1 As Workbook
    Dim MainBook As Workbook
    Dim Path As String
    Dim SheetName As String
    Dim originSheets As Variant
    Dim i As Integer
    Dim targetRow As Integer
    
    ' 获取输入文件路径
    Path = Worksheets("Input").Range("C6").Value
    ' 结果输出的目标工作表
    SheetName = "Data"
    
    ' 把所有需要处理的工作表名称放到数组里（可根据需要添加更多）
    originSheets = Array("F(AE)", "F(AL)", "F(AM)", "F(AR)", "F(AT)", "F(AU)")
    targetRow = 5 ' 目标工作表的起始行
    
    ' 设置目标工作簿（当前运行宏的工作簿）
    Set MainBook = ThisWorkbook
    
    ' 尝试打开源工作簿，处理文件不存在的情况
    On Error Resume Next
    Set Wb1 = Workbooks.Open(Path & "_20171231.xlsx")
    On Error GoTo 0
    If Wb1 Is Nothing Then
        MsgBox "源工作簿未找到，请检查路径！"
        Exit Sub
    End If
    
    ' 关闭屏幕更新，提升宏运行速度
    Application.ScreenUpdating = False
    
    ' 循环处理每个工作表
    For i = LBound(originSheets) To UBound(originSheets)
        Dim currentSheet As Worksheet
        ' 尝试获取当前工作表，捕获不存在的错误
        On Error Resume Next
        Set currentSheet = Wb1.Sheets(originSheets(i))
        On Error GoTo 0
        
        ' 如果工作表存在，执行复制操作
        If Not currentSheet Is Nothing Then
            ' 写入VLOOKUP公式（行号对应目标行的偏移）
            currentSheet.Range("N" & (24 + targetRow - 4)).FormulaR1C1 = "=VLOOKUP(""010"",C[-10]:C[-7],2,FALSE)"
            ' 复制计算后的值到目标工作表
            currentSheet.Range("N" & (24 + targetRow - 4)).Copy
            MainBook.Sheets(SheetName).Range("AW" & targetRow).PasteSpecial xlPasteValues
        End If
        
        ' 移动到目标工作表的下一行
        targetRow = targetRow + 1
    Next i
    
    ' 清理操作
    Application.CutCopyMode = False
    MainBook.Save
    Wb1.Close savechanges:=False
    Application.ScreenUpdating = True
    
    MsgBox "数据导入完成！"
End Sub

代码改进点： #

• 用数组存储所有工作表名称，避免大量重复的硬编码代码，后续添加新表只需修改数组即可
• 加入错误捕获处理工作表不存在的情况，遇到不存在的表自动跳过
• 增加了源工作簿不存在的检查，避免因文件路径错误导致的崩溃
• 关闭屏幕更新，大幅提升宏的运行速度
• 统一管理目标行号，避免硬编码行号带来的维护麻烦

解决方案2：提前检查工作表是否存在（更清晰的逻辑） #

如果你觉得错误捕获不够直观，可以写一个辅助函数，提前检查工作表是否存在，再决定是否执行操作：

首先添加这个辅助函数：

' 辅助函数：检查指定工作簿中是否存在某工作表
Function SheetExists(sheetName As String, wb As Workbook) As Boolean
    Dim ws As Worksheet
    On Error Resume Next
    Set ws = wb.Sheets(sheetName)
    On Error GoTo 0
    SheetExists = Not ws Is Nothing
End Function

然后在循环中使用这个函数：

' 替换原循环部分
For i = LBound(originSheets) To UBound(originSheets)
    ' 先检查工作表是否存在
    If SheetExists(originSheets(i), Wb1) Then
        Set currentSheet = Wb1.Sheets(originSheets(i))
        ' 写入VLOOKUP公式
        currentSheet.Range("N" & (24 + targetRow - 4)).FormulaR1C1 = "=VLOOKUP(""010"",C[-10]:C[-7],2,FALSE)"
        ' 复制值到目标工作表
        currentSheet.Range("N" & (24 + targetRow - 4)).Copy
        MainBook.Sheets(SheetName).Range("AW" & targetRow).PasteSpecial xlPasteValues
    End If
    targetRow = targetRow + 1
Next i

这种方式逻辑更清晰，适合需要复杂判断的场景，可读性更高。

总结 #

不管用哪种方案，核心思路都是：

1. 避免硬编码重复操作，改用循环批量处理
2. 对工作表的存在性进行判断/错误捕获，跳过不存在的表

这样你的宏就不会因为某个工作表不存在而中断，会自动处理完所有存在的工作表。

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