VBA For循环上下界应用异常：多指定工作表数据复制宏故障排查

我帮你排查了下代码里的问题，核心原因其实很容易被忽略：你用Evaluate("row(" & lo & ":" & hi & ")")生成的sheetlist是数字类型的数组，但Excel里Worksheets()这个方法有两种完全不同的用法：

• 传入数字：代表工作表的位置顺序（比如Worksheets(4)是第4个工作表，不管它叫什么名字）
• 传入字符串：代表工作表的名称（比如Worksheets("4")才是你要找的名为"4"的工作表）

你之前用Array("4","5","6")是字符串数组，所以能正确匹配工作表名称；但用Evaluate生成的数字数组，代码会把数字当成工作表的位置索引，直接跳到对应位置的工作表，完全不是你想要的按名称匹配的效果！

解决方案：把数字数组转换成字符串数组 #

有两种简单的方式可以实现：

方式1：修改Evaluate语句直接生成字符串数组

把生成数组的代码改成下面这样，用TEXT函数把行号转换成字符串格式：

Dim sheetlist As Variant
sheetlist = Application.Transpose(Evaluate("TEXT(row(" & lo & ":" & hi & "),""0"")"))

方式2：循环转换数组元素类型

如果不想改Evaluate，也可以加个循环把每个数字转成字符串：

Dim sheetlist As Variant
sheetlist = Application.Transpose(Evaluate("row(" & lo & ":" & hi & ")"))
' 循环转换每个元素为字符串
Dim i As Long
For i = LBound(sheetlist) To UBound(sheetlist)
    sheetlist(i) = CStr(sheetlist(i))
Next i

优化后的完整代码（建议避免使用Select/Activate） #

另外，你的代码里用了大量Select和Activate，这些操作不仅效率低，还容易因为窗口切换出问题，我帮你优化了这部分：

Sub Refresh()
    Dim lo As Long: lo = ActiveSheet.Range("B3").Value
    Dim hi As Long: hi = ActiveSheet.Range("C3").Value
    ' 直接生成字符串类型的工作表名称数组
    Dim sheetlist As Variant
    sheetlist = Application.Transpose(Evaluate("TEXT(row(" & lo & ":" & hi & "),""0"")"))
    
    Debug.Print "~~> " & Join(sheetlist, ","), _
          vbNewLine & "Boundaries: " & LBound(sheetlist) & " To " & UBound(sheetlist)
          
    ' 定义工作簿和工作表对象，避免Activate/Select
    Dim sourceWB As Workbook
    Dim targetWS As Worksheet
    Set sourceWB = Workbooks("Truck Log-East Gate-January.xlsx")
    Set targetWS = Workbooks("Truck Racks RawData.xlsm").Sheets("RawDataMacro")
    
    'Loop Through sheetlist
    Dim X As Long
    For X = LBound(sheetlist) To UBound(sheetlist)
        Dim sourceWS As Worksheet
        On Error Resume Next ' 防止工作表不存在报错
        Set sourceWS = sourceWB.Worksheets(sheetlist(X))
        On Error GoTo 0
        
        If Not sourceWS Is Nothing Then
            ' 复制数据区域（从A4到最后一行有数据的行）
            Dim copyRange As Range
            Set copyRange = sourceWS.Range("A4:R" & sourceWS.Cells(sourceWS.Rows.Count, "A").End(xlUp).Row)
            ' 粘贴到目标表的下一行空白处
            copyRange.Copy
            targetWS.Cells(targetWS.Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
            Application.CutCopyMode = False ' 清除复制状态
        Else
            Debug.Print "工作表 " & sheetlist(X) & " 不存在！"
        End If
    Next X
End Sub

额外提示 #

• 加了On Error Resume Next是为了防止用户输入的数字对应的工作表不存在时，代码直接崩溃，同时会在调试窗口提示哪个工作表找不到。
• 用对象变量（sourceWB、targetWS等）代替Activate和Select，代码会更稳定高效。

内容的提问来源于stack exchange，提问作者Ross.P