将工作表复制到其他工作簿后条件格式失效的解决求助

我帮你分析下这个问题：你遇到的条件格式#REF!错误，本质是因为复制的工作表依赖源工作簿里的其他工作表（比如你提到的Lists表），但你只复制了目标工作表，源工作簿关闭后这些跨文件引用就失效了。另外你原来的代码里用Workbooks.Add()打开源文件是个小错误——这个方法是基于指定文件创建新工作簿，正确打开现有文件应该用Workbooks.Open()，这也可能加剧了引用异常的问题。

下面给你几个适配Excel 2016的可行解决方案：

方案1：同时复制依赖的工作表（保留动态规则） #

如果源工作簿里的Lists表是条件格式必需的依赖项，最简单的办法是把它也复制到当前工作簿，让引用指向本地工作表。修改后的VBA代码如下：

Sub CopyWorksheetWithDependencies()
    Const directoryPath = "myPath"
    Const fileName = "filname.xlsx"
    Const mainWorksheetName = "worksheetname"
    Const dependentWorksheetName = "Lists" ' 条件格式依赖的工作表
    Dim wbSource As Workbook
    Dim wsSource As Worksheet
    Dim wsDependent As Worksheet
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    ' 正确打开源工作簿
    Set wbSource = Workbooks.Open(directoryPath & fileName)
    
    ' 删除当前工作簿中已有的同名表（如果存在）
    On Error Resume Next
    ThisWorkbook.Worksheets(dependentWorksheetName).Delete
    ThisWorkbook.Worksheets(mainWorksheetName).Delete
    On Error GoTo 0
    
    ' 先复制依赖表到当前工作簿
    Set wsDependent = wbSource.Worksheets(dependentWorksheetName)
    wsDependent.Copy Before:=ThisWorkbook.Worksheets(1)
    
    ' 再复制主工作表
    Set wsSource = wbSource.Worksheets(mainWorksheetName)
    wsSource.Copy Before:=ThisWorkbook.Worksheets(1)
    
    ' 关闭源工作簿，不保存修改
    wbSource.Close SaveChanges:=False
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Importing done with dependencies!"
End Sub

方案2：复制后批量修复条件格式引用 #

如果不需要复制依赖表，而是已经把Lists的数据迁移到了当前工作簿，可以在复制完成后，遍历目标工作表的所有条件格式规则，替换掉错误的#REF!引用：

Sub FixConditionalFormattingRefs()
    Dim wsTarget As Worksheet
    Dim cfRule As FormatCondition
    Dim oldRef As String
    Dim newRef As String
    
    Set wsTarget = ThisWorkbook.Worksheets("worksheetname") ' 复制后的目标工作表
    oldRef = "[filename1.xlsx]Lists!#REF!" ' 要替换的错误引用文本
    newRef = "Lists!$A$1:$Z$100" ' 当前工作簿中对应数据的引用，根据实际范围修改
    
    ' 遍历所有条件格式规则
    For Each cfRule In wsTarget.Cells.FormatConditions
        ' 替换公式1中的错误引用
        cfRule.Formula1 = Replace(cfRule.Formula1, oldRef, newRef)
        ' 针对「介于」这类需要双公式的规则，同时替换公式2
        If cfRule.Type = xlCellValue And cfRule.Operator = xlBetween Then
            cfRule.Formula2 = Replace(cfRule.Formula2, oldRef, newRef)
        End If
    Next cfRule
    
    MsgBox "条件格式引用修复完成！"
End Sub

你可以把这段代码加到原复制流程的末尾（wbSource.Close之后）自动执行修复。

方案3：复制静态格式（放弃动态规则） #

如果不需要保留条件格式的动态判断逻辑，只需要保留当前单元格的显示格式，可以先把源工作表的格式固化后再复制：

Sub CopyWithStaticFormatting()
    Const directoryPath = "myPath"
    Const fileName = "filname.xlsx"
    Const worksheetName = "worksheetname"
    Dim wbSource As Workbook
    Dim wsSource As Worksheet
    Dim wsNew As Worksheet
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    Set wbSource = Workbooks.Open(directoryPath & fileName)
    Set wsSource = wbSource.Worksheets(worksheetName)
    
    ' 在当前工作簿新建目标工作表
    Set wsNew = ThisWorkbook.Worksheets.Add(Before:=ThisWorkbook.Worksheets(1))
    wsNew.Name = worksheetName
    
    ' 复制列宽、值+数字格式、单元格格式
    wsSource.Cells.Copy
    With wsNew.Cells
        .PasteSpecial Paste:=xlPasteColumnWidths
        .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        .PasteSpecial Paste:=xlPasteFormats
    End With
    Application.CutCopyMode = False
    
    ' 关闭源工作簿
    wbSource.Close SaveChanges:=False
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "静态格式复制完成！"
End Sub

额外提示：手动修复工作簿链接 #

如果粘贴后仍有链接错误，可以通过Excel「数据」选项卡→「编辑链接」功能，查看所有外部链接，将错误的源路径替换为正确路径，或者断开不需要的链接。也可以用VBA批量处理：

Sub FixBrokenLinks()
    Dim link As Variant
    Dim oldLink As String
    Dim newLink As String
    
    oldLink = "filename1.xlsx" ' 错误的源文件名
    newLink = ThisWorkbook.FullName ' 替换为当前工作簿路径，或正确的源文件路径
    
    For Each link In ThisWorkbook.LinkSources(xlExcelLinks)
        If InStr(link, oldLink) > 0 Then
            ThisWorkbook.ChangeLink Name:=link, NewName:=newLink, Type:=xlExcelLinks
        End If
    Next link
End Sub

内容的提问来源于stack exchange，提问作者Mátray Márk