咱们直接说问题根源和解决方案，你的代码里有两个关键问题导致编译错误，而且依赖Select/Activate的写法也容易在特定工作簿环境下失效——这也是为啥复制到其他工作簿能运行的原因之一：

错误1：With块内的重复.Interior调用 #

看这段出问题的代码：

With selection.Interior
    .Pattern = xlSolid
    .Interior.PatternColorIndex = xlAutomatic
    .Interior.ThemeColor = xlThemeColorAccent6
    .Interior.TintAndShade = 0
    .Interior.PatternTintAndShade = 0
End With

当你用With selection.Interior时，块内所有.开头的属性都是直接指向selection.Interior的，所以.Interior.PatternColorIndex相当于selection.Interior.Interior.PatternColorIndex——这显然是不存在的，VBA找不到这个属性，就会抛出编译错误。

错误2：selection的大小写与潜在冲突 #

虽然VBA不严格区分大小写，但如果你的工作簿里不小心定义了名为selection的小写变量，就会和内置的Selection对象冲突。规范写法是用首字母大写的Selection指代内置对象。

优化后的稳定代码（去掉易出错的Select/Activate） #

另外，你原来的代码大量用Select和Activate，这在当前工作簿不是活动簿时很容易失效。咱们改成直接操作对象的写法，更可靠：

Dim iPhase As Integer
Dim h As Integer
Dim foundCell As Range
Dim ws As Worksheet

' 指定要操作的工作表，避免活动表切换导致错误
Set ws = ThisWorkbook.ActiveSheet ' 也可以换成具体表名，比如Sheets("数据导入表")

iPhase = Application.WorksheetFunction.CountIf(ws.Range("A:A"), "Phase")
h = 1
Set foundCell = ws.Range("A6")

Do Until h > iPhase
    ' 直接查找并返回单元格对象，不用Activate
    Set foundCell = ws.Cells.Find(What:="Phase", After:=foundCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
    
    If Not foundCell Is Nothing Then
        ' 直接操作目标区域，不用Select
        With ws.Range(foundCell, foundCell.Offset(0, 16)).Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent6
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
        ws.Range(foundCell, foundCell.Offset(0, 16)).Font.Bold = True
        h = h + 1
    Else
        ' 防止找不到内容导致死循环
        Exit Do
    End If
Loop

额外说明 #

• 新增了foundCell是否为Nothing的判断，避免找不到"Phase"时陷入死循环；
• 直接绑定操作的工作表ws，不管当前活动表是什么，都能准确操作目标表；
• 彻底去掉了Select/Activate，这是编写稳定VBA代码的最佳实践，能避免很多环境依赖的错误。

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