如何通过宏在新建Excel工作簿中保留条件格式结果

嗨，我完全懂你的困扰——你想要把原工作表中条件格式实际渲染出来的效果（比如单元格的背景色、字体颜色这些）复制到新工作簿，而不是仅仅粘贴条件格式规则本身（毕竟新工作簿可能没有原规则的依赖数据，导致格式不生效）。

你当前的代码用了xlPasteValuesAndNumberFormats加xlPasteFormats，但后者粘贴的是单元格的基础格式和条件格式规则，而不是已经应用到单元格上的静态格式。如果原条件格式依赖于原工作表的其他数据，粘贴到新工作簿后规则会失效，自然看不到预期的格式效果。

咱们来调整一下代码，给你两种解决方案：

方案一：保留静态格式（无CF规则，推荐） #

这种方法会把原单元格的显示效果直接固化为静态格式，不需要依赖任何条件格式规则，新工作簿的单元格会直接保留原有的颜色、字体等样式：

Sub Create_Monthly_Return()
    ' 取消原工作表保护
    ThisWorkbook.Worksheets("Monthly Return").Unprotect Password:="password"
    
    ' 定位原工作表要复制的区域
    Dim sourceRange As Range
    Set sourceRange = ThisWorkbook.Worksheets("Monthly Return").Columns("A:N")
    sourceRange.Copy
    
    ' 创建新工作簿并粘贴内容
    Dim newWB As Workbook
    Set newWB = Workbooks.Add
    With newWB.Worksheets(1).Range("A1")
        ' 先粘贴所有内容（包括格式和CF规则）
        .PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        ' 把公式转换为静态值，保留已渲染的格式
        .Resize(sourceRange.Rows.Count, sourceRange.Columns.Count).Value = .Resize(sourceRange.Rows.Count, sourceRange.Columns.Count).Value
    End With
    
    ' 重新保护原工作表
    ThisWorkbook.Worksheets("Monthly Return").Protect Password:="password"
    
    ' 清除剪贴板（避免后续误粘贴）
    Application.CutCopyMode = False
End Sub

方案二：保留CF规则（需确保规则生效） #

如果你希望新工作簿也能保留条件格式规则（比如后续要更新新工作簿的数据，让CF自动生效），可以直接粘贴值和完整的格式规则：

Sub Create_Monthly_Return()
    ' 取消原工作表保护
    ThisWorkbook.Worksheets("Monthly Return").Unprotect Password:="password"
    
    ' 复制原工作表A:N列数据
    ThisWorkbook.Worksheets("Monthly Return").Columns("A:N").Copy
    
    ' 创建新工作簿并粘贴
    Dim newWB As Workbook
    Set newWB = Workbooks.Add
    With newWB.Worksheets(1).Range("A1")
        ' 粘贴值和数字格式
        .PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        ' 粘贴基础格式
        .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        ' 单独粘贴条件格式规则（确保规则被复制）
        .PasteSpecial Paste:=xlPasteConditionalFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    End With
    
    ' 重新保护原工作表
    ThisWorkbook.Worksheets("Monthly Return").Protect Password:="password"
    
    ' 清除剪贴板
    Application.CutCopyMode = False
End Sub

注意：方案二需要确保原条件格式的引用是相对路径，或者新工作簿中存在对应的数据，否则规则可能无法正常触发格式效果。

备注：内容来源于stack exchange，提问作者OWalker