VBA kopiert Bedingte Formatierung nicht

[MiBi]

Hallo Clever Excel Forum,

beim kopieren von Daten in ein anderes Tabellenblatt, kopiert mein VBA Code komischerweise nicht die dort enthaltene Bedingte Formatierung. In Tabellenblatt "B" sind Zeilen, die durch die Bedingte Formatierung markiert sind. In Tabellenblatt "A" soll es kopiert werden, nur nimmt er immer die Gelbe Markierung raus. Ich habe schon versucht die Bedingte Formatierung in Tabellenblatt "A" einzufügen, jedoch löscht er es immer wieder da ich den Bereich immer wieder löschen muss und Zahlen ersetzen muss.

Der Code lautet:

Code:

Sub Kopieren()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Range("A7:C35200").Select
Selection.Clear

Worksheets("B").Range("Tab_2018").Copy
    Range("A7:B7").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
   
[D5].Value = 2018

      Dim iRow As Long
        iRow = Cells(Rows.Count, 1).End(xlUp).Row
        Range("C7").Formula = "=(B7/4)"
        Range("C7:C" & iRow).FillDown
       
Cells(1, 1).Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Hat jemand eine Idee, wie ich das lösen könnte ? 
Über eine Antwort würde ich mich freuen.

Viele Grüße

MiBi


EDIT: Hab nun die bedingte Formatierung aufgenommen und dem Code hinzugefügt. Funktioniert jetzt :) Danke an die, die sich Gedanken gemacht haben.

[Glausius]

Hallo,

und wie sieht dein ergänzert Code nun aus?
Zeige doch einmal das Ergebnis!

[MiBi]

Hallo,

und wie sieht dein ergänzert Code nun aus?
Zeige doch einmal das Ergebnis!

Hallo Glausius,

hier bitte :)

Code:

Sub Kopieren()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Range("A7:C35200").Select
Selection.Clear

Worksheets("B").Range("Tab_2018").Copy
    Range("A7:B7").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

[D5].Value = 2018
      Dim iRow As Long
        iRow = Cells(Rows.Count, 1).End(xlUp).Row
        Range("C7").Formula = "=(B7/4)"
        Range("C7:C" & iRow).FillDown
       
                    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=ZÄHLENWENN(Daten;GANZZAHL(A7))"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
       
Cells(1, 1).Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Gruß

MiBi