升级Office 365后Excel VBA复制粘贴功能失效求助

故障原因 #

Office 365对VBA的隐式操作、剪贴板调用的校验规则比旧版Office严格很多，旧版会自动兜底的不规范写法在365里会直接执行失败。你这段代码的粘贴失效主要是几个问题导致的：

• 全程依赖Select/Selection对象，执行过程中如果有界面操作干扰就会错位
• 筛选后复制没有显式指定仅复制可见单元格，365不会默认自动过滤隐藏行
• PasteSpecial没有指定粘贴参数，365默认规则和旧版不兼容
• 大量隐式工作表引用，容易误读其他工作表的单元格数据

修复后代码 #

Application.StatusBar = "GENERATE LIST OF LICENSES DUE TO EXPIRE"
Dim wsExpire As Worksheet, wsImport As Worksheet, wsMain As Worksheet
Set wsExpire = Sheets("due to expire")
Set wsImport = Sheets("Import")
Set wsMain = Sheets("Main")

' 清空目标表数据
wsExpire.Columns("A:I").ClearContents

' 处理筛选逻辑
Dim lngStart As Long, lngEnd As Long
lngStart = wsImport.Range("M1").Value '起始日期
lngEnd = wsImport.Range("P1").Value '结束日期
If wsImport.AutoFilterMode Then wsImport.AutoFilterMode = False '先清空已有筛选
wsImport.Range("A1:I5000").AutoFilter field:=9, _
    Criteria1:=">=" & lngStart, _
    Operator:=xlAnd, _
    Criteria2:="<=" & lngEnd

' 仅复制筛选后的可见单元格，直接粘贴到目标表
wsImport.Range("A1:I5000").SpecialCells(xlCellTypeVisible).Copy
wsExpire.Range("A1").PasteSpecial Paste:=xlPasteAll '需要仅粘贴数值就改成xlPasteValues
wsExpire.Cells.EntireColumn.AutoFit
Application.CutCopyMode = False '清空剪贴板

' 处理多余行删除
Dim Number_of_Records As Long, Selection_Range As String
Number_of_Records = wsMain.Range("L7").Value + 2
wsExpire.Rows(Number_of_Records & ":1000000").Delete Shift:=xlUp

' 处理J列自动填充
Number_of_Records = wsMain.Range("L7").Value + 1
wsExpire.Range("J2").AutoFill Destination:=wsExpire.Range("J2:J" & Number_of_Records)

' 清空导入表筛选
If wsImport.AutoFilterMode Then wsImport.AutoFilterMode = False

额外说明 #

如果你的原需求需要保留单元格公式，直接用代码里默认的xlPasteAll即可，如果只需要粘贴数值，把Paste参数改成xlPasteValues就行。修复后的代码完全不依赖界面选择操作，执行稳定性比原代码高很多。

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