如何将多个工作表复制到另一工作簿？VBA代码报错求助

报错核心原因 #

语句Set wsCopy = Workbooks("acex_resultsv1.xlsm").Worksheets(i)中断，大概率是以下几种情况：

• 工作簿未打开/文件名错误：如果acex_resultsv1.xlsm没在Excel中打开，或者文件名拼写有误（比如大小写、后缀名、特殊字符/空格遗漏），VBA无法定位到目标工作簿。
• 工作表索引越界：你的循环条件i <= Worksheets.Count取的是当前激活工作簿的工作表数量，但源工作簿acex_resultsv1.xlsm的工作表数量可能更少，当i超过源工作簿的表总数时，就会因找不到对应索引的工作表报错。
• 工作表状态异常：源工作簿中第i个工作表被删除、隐藏或保护，导致无法正常引用。

修复优化后的代码 #

Public Sub Update_Dashboard()
    Dim wbCopy As Workbook
    Dim wbDest As Workbook
    Dim wsCopy As Worksheet
    Dim wsDest As Worksheet
    Dim lCopyLastRow As Long
    Dim i As Integer
    
    ' 先验证两个工作簿是否已打开
    On Error Resume Next
    Set wbCopy = Workbooks("acex_resultsv1.xlsm")
    Set wbDest = Workbooks("acex_results.xlsm")
    On Error GoTo 0
    
    If wbCopy Is Nothing Or wbDest Is Nothing Then
        MsgBox "请确保acex_resultsv1.xlsm和acex_results.xlsm都已打开", vbExclamation
        Exit Sub
    End If
    
    ' 基于源工作簿的工作表数量循环，避免索引越界
    For i = 1 To wbCopy.Worksheets.Count
        Set wsCopy = wbCopy.Worksheets(i)
        ' 检查目标工作簿是否存在对应工作表（i+1）
        If i + 1 <= wbDest.Worksheets.Count Then
            Set wsDest = wbDest.Worksheets(i + 1)
            
            ' 获取源数据最后一行
            lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
            
            ' 清空目标区域旧数据
            wsDest.Range("A2:BI" & wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Row).ClearContents
            
            ' 仅当有数据时执行复制
            If lCopyLastRow >= 2 Then
                wsCopy.Range("A2:BI" & lCopyLastRow).Copy wsDest.Range("A2")
            End If
        Else
            MsgBox "目标工作簿缺少第" & i + 1 & "个工作表", vbExclamation
        End If
    Next i
    
    ' 切换到Dashboard工作表（明确指定工作簿）
    wbDest.Worksheets("Dashboard").Select
End Sub

关键优化说明 #

• 移除Select操作：直接通过对象引用工作簿和工作表，避免因窗口切换导致的意外错误。
• 增加前置检查：提前验证工作簿是否存在，给出清晰的错误提示。
• 修正循环逻辑：基于源工作簿的表数量循环，彻底避免索引越界问题。
• 增加边界判断：检查目标工作表是否存在、源表是否有数据，减少无效操作和报错。

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