Hallo,

ich bräuchte ein Makro, das die bedingte Formatierung auf jede Zeile bis zur letzten Zeile kopiert.

Ich habe in den Zeilen (beginnend in der Zeile 3) die jeweiligen Datensätze und dazwischen sind die Teilergebnisse nach Jahren (in der Spalte C steht dann 2010 Ergebnis, 2011 Ergebnis, 2012 Ergebnis usw. oder am Schluss Gesamtergebnis) Und eben die ganzen Zeilen mit den Teilergebnissen und dem Gesamtergebnis sollten formatiert werden.

Dafür habe ich folgende bedingte Formatierung gebastelt:

    Rows("3:3").Select   

    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _

        "=FINDEN(""Ergebnis"";$C3)"

    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority

    With Selection.FormatConditions(1).Font

        .Bold = True

        .Italic = False

        .Color = -16776961

        .TintAndShade = 0

    End With

    Selection.FormatConditions(1).StopIfTrue = False

    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _

        "=$C3=""Gesamtergebnis"""

    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority

    With Selection.FormatConditions(1).Font

        .Bold = True

        .Italic = False

        .ThemeColor = xlThemeColorAccent1

        .TintAndShade = 0

    End With

Ich bräuchte ein Makro, das die letzte Zeile eruiert und dann diese bedingte Formatierung von der Zeile 3 bis zu der letzten Zeile einfügt, so dass die ganzen Formatierung dann nicht von C3 abhängig sind, sonder Zeile 4 von C4, Zeile 5 von C5 usw.

Damit ich den Code:

Selection.FormatConditions(1).StopIfTrue = False
    Selection.Copy
    Rows("4:4").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Rows("5:5").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Rows("6:6").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Rows("7:7").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Rows("8:8").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Rows("9:9").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Rows("10:10").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False

nicht bis zu 500 und mehr händisch ausschreiben muss :( 

Ist so etwas möglich? Könnte mir da vielleicht jemand helfen?

Danke!

LG