Bedingte Formatierung Zeilenweise vba

[Lernender]

Hallo zusammen

Ich möchte eine bedingte Formatierung über 15 Spalten zeilenweise (auf 80 Zeilen) übernehmen. Habe mir folgenden Code zusammengeschnippselt. Leder färbt er nur die erste Zeile (Zeile 20) ein  und überspringt dann die For next schleife.

Was mache ich falsch?

Code:

Sub M4_Farben_max()
'
'
Dim lngrow As Long
'
    Range("B20:Q20").Select
    Selection.FormatConditions.AddColorScale ColorScaleType:=3
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _
        xlConditionValueLowestValue
    With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor
        .Color = 7039480
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _
        xlConditionValuePercentile
    Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50
    With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor
        .Color = 8711167
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _
        xlConditionValueHighestValue
    With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor
        .Color = 8109667
        .TintAndShade = 0
    End With

    Range("B20:Q20").Select
    Selection.Copy
   
For lngrow = 20 To Cells(Rows.Count, 20).End(xlUp).Row
    Cells(lngrow, 21).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
       
Application.ScreenUpdating = False
Next
Application.CutCopyMode = False

Application.ScreenUpdating = True
    Range("A2").Select

Wäre froh um einen Tipp
Gruss vom Lernenden

[Klaus-Dieter]

Hallo,

Was mache ich falsch?

du versucht etwas mit einem Makro zu lösen, dass man mit wenigen Mausklicks bekommen kann.

[Lutz Fricke]

Hallo Lernender,

welchen Wert hat denn Cells(Rows.Count, 20).End(xlUp).Row?
Du ermittelst mit dem Code die letzte beschrieben Zeile in Spalte T. Stehen da überhaupt noch Werte?

Im restlichen Code bearbeitest Du nur die Spalten B bis Q (also 2 bis 17).

Ändere bei Cells(Rows.Count, 20).End(xlUp).Row die 20 in die Spaltennummer einer Spalte, die auf jeden Fall bis zum Ende beschrieben ist (z.B.2).

Gruß,
Lutz

[Lernender]

Hallo Lutz

Herzlichen Dank für den Tipp, 

so funktionierts.

For lngrow = 20 To Cells(Rows.Count, 17).End(xlUp).Row 'Ingrow = Zeile
    Cells(lngrow, 2).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

Gruss vom Lernenden