相同VBA宏在不同电脑运行结果不一致问题求助

• 优先排查工作表对象引用错误：原代码中Set ws1 = Worksheets("Sheet1")未明确指定所属工作簿，若同事电脑运行宏时存在其他已打开的工作簿也有名为Sheet1的工作表，会导致引用错位，粘贴操作执行到了其他工作簿，目标工作表自然无变化。
• 其次排查Office版本兼容性问题：部分精简版/盗版Office会丢失VBA内置枚举常量定义，xlPasteValues的常量值无法被正确识别，导致粘贴操作未生效。
• 第三排查工作表权限问题：如果目标文件的Sheet1处于保护状态，由于你设置了Application.DisplayAlerts = False，操作被拦截时不会弹出报错，会直接静默跳过粘贴数值的步骤。
• 最后排查复制粘贴逻辑异常：部分Excel版本对整表复制+整表粘贴的操作支持不好，遇到合并单元格、隐藏行列、超大数据量时容易触发异常，直接赋值的方式比剪贴板操作稳定性高很多。

优化点说明：

1. 所有工作表对象明确绑定到目标工作簿，彻底避免引用错位
2. 替换剪贴板复制粘贴逻辑为直接赋值，兼容性更强、运行效率更高
3. 增加工作表保护状态判断，避免操作静默失败
4. 删除冗余的工作簿激活操作，无需激活即可完成所有操作

Sub rename_other_workbookSheet()
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim Path As String
    Dim FileName As String
    Dim wb As Workbook
    Dim sht As Worksheet
    Dim usedRng As Range
    
    Path = Application.ThisWorkbook.Path
    FileName = Dir(Path & "\*.xl*", vbNormal)
    
    Do Until FileName = ""
        If InStr(UCase(FileName), "MAPPING_FILE") > 0 Then
            Set wb = Workbooks.Open(Path & "\" & FileName)
            For Each sht In wb.Worksheets
                If sht.Name = "Sheet1" Then
                    ' 若工作表有保护密码，可在Unprotect后加密码参数：sht.Unprotect "密码"
                    If sht.ProtectContents Then sht.Unprotect
                    sht.Name = "Mapping"
                    ' 直接赋值替换剪贴板操作，一次性清除所有公式保留数值
                    Set usedRng = sht.UsedRange
                    usedRng.Value = usedRng.Value
                End If
            Next sht
            wb.Save
            wb.Close
        End If
        FileName = Dir()
    Loop

    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

如果不想先修改代码，可以让同事把宏开头的Application.DisplayAlerts = False注释掉后重新运行，观察弹出的报错提示，即可快速定位具体故障原因。

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