简体   繁体   中英

Excel VBA copy cell formatting to range

I am creating a macro using conditional formatting. Purpose of the macro is to change the formatting (cell color and text font (bold/italic/...) and size) of cells in columns A to M, depending on the value of column M.

I defined 5 conditions and changed the conditional formatting of the cells of column M, so far so good, but I don't seem to be able to copy those formats using the PasteSpecial command.

In short: cells A3 to M3 should have the same formatting as N3, A4 to M4 the same as N4, and so on.

VBA included below, thanks in advance!

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

Your code works fine for me (even if column N has a diff number of rows than AM).

Have you tried clearing all conditional formats on the sheet before running it?

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

Can't you just get rid of conditional formatting?

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM