範囲にExcel VBAコピーセルの書式設定

Question

条件付き書式を使用してマクロを作成しています。マクロの目的は、列Mの値に応じて、列A〜Mのセルのセルの色（セルの色とテキストのフォント（太字/斜体/ ...）とサイズ）を変更することです。

定義済み5条件を変更し、列Mのセルの条件付き書式を変更しましたが、これまでのところ良いですが、PasteSpecialコマンドを使用してこれらの書式をコピーできないようです。

要するに、A3からM3のセルは、N3と同じ書式設定、A4からM4はN4と同じになります。

以下にVBAが含まれています。ありがとうございます！

Sub VoorwaardelijkeOpmaak() 
' 
' VoorwaardelijkeOpmaak Macro 
' 
' Sneltoets: Ctrl+Shift+Z 
' 
If ActiveSheet.Name <> "gedetailleerde meetstaat" Then 
    MsgBox "Deze macro kan alleen in het werkblad 'gedetailleerde meetstaat' worden toegepast" 
Else 
Dim rg As Range 
Dim cond1 As FormatCondition, cond2 As FormatCondition, cond3 As FormatCondition, cond4 As FormatCondition, cond5 As FormatCondition 
Set rg = Range("N3", Range("N3").End(xlDown)) 

'clear any existing conditional formatting 
rg.FormatConditions.Delete 

'define the rule for each conditional format 
Set cond1 = rg.FormatConditions.Add(xlCellValue, xlEqual, "1") 
Set cond2 = rg.FormatConditions.Add(xlCellValue, xlEqual, "2") 
Set cond3 = rg.FormatConditions.Add(xlCellValue, xlEqual, "3") 
Set cond4 = rg.FormatConditions.Add(xlCellValue, xlEqual, "4") 
Set cond5 = rg.FormatConditions.Add(xlCellValue, xlEqual, "5") 

'define the format applied for each conditional format 
With cond1 
.Font.Color = RGB(0, 0, 0) 
.Font.Bold = True 
End With 

With cond2 
.Font.Color = RGB(128, 0, 0) 
.Font.Bold = True 
End With 

With cond3 
.Font.Color = RGB(255, 0, 0) 
.Font.Bold = True 
End With 

With cond4 
.Font.Color = RGB(0, 176, 80) 
.Font.Bold = True 
End With 

With cond5 
.Font.Color = RGB(31, 73, 125) 
.Font.Bold = True 
End With 

Range("N3", Range("N3").End(xlDown)).Select 
Selection.Copy 
Range("A3:M3", Range("A3:M3").End(xlDown)).Select 
Selection.PasteSpecial (xlPasteFormats) 

End If 

End Sub 

Answer 1

Sub VoorwaardelijkeOpmaak() 
' 
' VoorwaardelijkeOpmaak Macro 
' 
' Sneltoets: Ctrl+Shift+Z 
' 
If ActiveSheet.Name <> "gedetailleerde meetstaat" Then 
    MsgBox "Deze macro kan alleen in het werkblad 'gedetailleerde meetstaat' worden toegepast" 
Else 
Dim rg As Range 
Dim cond1 As FormatCondition, cond2 As FormatCondition, cond3 As FormatCondition, cond4 As FormatCondition, cond5 As FormatCondition 
Set rg = Range("N3", Range("N3").End(xlDown)) 

For Each cell In rg 

If cell.Value = "1" Then 
cell.Font.Color = RGB(128, 0, 0) 
cell.Font.Bold = True 

ElseIf cell.Value = "2" Then 
cell.Font.Color = RGB(128, 0, 0) 
cell.Font.Bold = True 


ElseIf cell.Value = "3" Then 
cell.Font.Color = RGB(255, 0, 0) 
cell.Font.Bold = True 


ElseIf cell.Value = "4" Then 
cell.Font.Color = RGB(0, 176, 80) 
cell.Font.Bold = True 


ElseIf cell.Value = "5" Then 
cell.Font.Color = RGB(31, 73, 125) 
cell.Font.Bold = True 

End If 


Next 



Range("N3", Range("N3").End(xlDown)).Select 
Selection.Copy 
Range("A3:M3", Range("A3:M3").End(xlDown)).Select 
Selection.PasteSpecial (xlPasteFormats) 

End If 

End Sub 

条件付き書式設定を解除できませんか？

Answer 2

あなたのコードは（N列にA-Mよりも異なる行数があっても）うまく動作します。

実行する前に、シート上のすべての条件付き書式を消去しようとしましたか？