如何用Excel VBA仅复制指定区域的单元格填充颜色至目标区域？

首先修正你原始代码中的语法错误，确保G列的条件格式能正常运行：

Sub Conditional_Formatting()
    Dim Scorecard As String
    Scorecard = ActiveSheet.Name
    
    Dim formatted_range As Range
    Set formatted_range = Sheets(Scorecard).Range("G4:G11")
    
    With formatted_range.FormatConditions
        .Delete
        ' 修正空值无填充的条件格式语法
        .Add(Type:=xlExpression, Formula1:="=" & .Parent.Cells(1).Address(0, 0) & "=""""""")
        .Item(.Count).Interior.ColorIndex = xlNone
        
        .Add(Type:=xlCellValue, Operator:=xlLess, Formula1:="-.02")
        .Item(.Count).Interior.Color = RGB(255, 0, 0)
        
        .Add(Type:=xlCellValue, Operator:=xlBetween, Formula1:="-.02", Formula2:="-.0199999999")
        .Item(.Count).Interior.Color = RGB(255, 255, 0)
        
        .Add(Type:=xlCellValue, Operator:=xlGreater, Formula1:="0")
        .Item(.Count).Interior.Color = RGB(0, 128, 0)
    End With
End Sub

接下来提供两种实现F列颜色同步的方案：

方法一：动态同步（条件格式关联G列值） #

这种方案会给F4:F11添加条件格式，直接引用对应G列单元格的值，当G列数据变化时，F列颜色会自动更新。在原代码末尾添加以下代码即可：

' 将G列的条件格式逻辑应用到F列，关联对应G单元格的值
Dim target_range As Range
Set target_range = Sheets(Scorecard).Range("F4:F11")

With target_range.FormatConditions
    .Delete
    ' 对应G单元格为空时，F单元格无填充
    .Add(Type:=xlExpression, Formula1:="=G" & target_range.Cells(1).Row & "=""""""")
    .Item(.Count).Interior.ColorIndex = xlNone
    
    ' G单元格值小于-0.02时，F单元格变红
    .Add(Type:=xlExpression, Formula1:="=G" & target_range.Cells(1).Row & "<-.02")
    .Item(.Count).Interior.Color = RGB(255, 0, 0)
    
    ' G单元格值在-0.02到-0.0199999999之间时，F单元格变黄
    .Add(Type:=xlExpression, Formula1:="=AND(G" & target_range.Cells(1).Row & ">-.02, G" & target_range.Cells(1).Row & "<=-.0199999999)")
    .Item(.Count).Interior.Color = RGB(255, 255, 0)
    
    ' G单元格值大于0时，F单元格变绿
    .Add(Type:=xlExpression, Formula1:="=G" & target_range.Cells(1).Row & ">0")
    .Item(.Count).Interior.Color = RGB(0, 128, 0)
End With

方法二：静态复制（一次性复制当前颜色） #

如果只需要复制当前G列的填充颜色到F列，不需要后续自动更新，可在原条件格式设置完成后添加以下代码：

' 复制G列当前填充颜色到F列
Sheets(Scorecard).Range("G4:G11").Copy
Sheets(Scorecard).Range("F4:F11").PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False

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