Clever-Excel-Forum

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? Huh

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

Hallo,

Zitat:Was mache ich falsch?

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

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

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

Lernender

Klaus-Dieter

Lutz Fricke

Lernender