Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

VBA kopiert Bedingte Formatierung nicht
#1
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 jetztSmile Danke an die, die sich Gedanken gemacht haben.
Antwortento top
#2
Hallo,

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

Gruß Günter
aus der Helden-, Messe-, Musik-, Buch-, Universitäts- und Autostadt Leipzig
Antwortento top
#3
(15.09.2020, 14:37)Glausius schrieb: Hallo,

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

hier bitteSmile

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
Antwortento top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste