Hallo zusammen,
eine kleine Frage zur bedingten Formatierung.
Ich möchte über ein Makro den Inhalt von Zellen kopieren inkl. der in den Zellen hinterlegten Farbe.
In den Zielzellen ist allerdings bereits eine bedingte Formatierung hinterlegt, welche ich beibehalten möchte.
Kopiere ich mit copy/paste, nimmt das Makro beim Kopieren die Farbe mit, überschreibt bzw. löscht aber auch die bedingte Formatierung.
Verwende ich "PasteSpecial Paste:=xlPasteValues" behält er zwar die Bedingte Formatierung in der Zielzelle bei, kopiert mir allerdings nicht die Färbung der Quellzelle mit.
Gibt er hierfür eine Lösung?
Grüße
Sebbo
Hallöchen,
Du könntest in Deinem Makro die Farben einzeln übertragen oder die bedingte Formatierung neu setzen.
Hallo Sebbo,
die andere Variante wäre, den Zellwert und die Zellfarbe zu kopieren bzw. zu übernehmen:
Code:
Sub Kopieren()
Dim Quellzelle As Range, Zielzelle As Range
Set Quellzelle = Range("B10")
Set Zielzelle = Range("B14")
Zielzelle.Value = Quellzelle.Value
Zielzelle.Interior.Color = Quellzelle.Interior.Color
End Sub
Beachte aber, das Bedingte Formate Vorrang vor fixen Zellformaten haben, so dass es sein kann, dass die fixe durch die Bedingte Formatierung "überschrieben" wird.
Gruß Uwe
Hallo ihr beiden,
danke für euer Feedback und sorry für meine späte Antwort!
@Uwe: Vielen Dank für deinen Vorschlag! Das funktioniert einwandfrei und in der Zielzelle werden die bedingten Formatierungen beibehalten. Super! Wieder was gelernt
Viele Grüße
Sebbo
Jetzt habe ich doch noch eine Frage:
Gibt es eine Möglichkeit über VBA auch eine zweifarbige Zelle zu kopieren?
Also konkret, ein paar der zu kopierenden Zellen sind über "Fülleffekte" mit zwei verschiedenen Farben gefüllt.
Wenn ich diese jetzt mit dem Befehl "interior.color" kopiere, erhalte ich in der Zielzelle nur eine komplett schwarze Einfärbung.
Gibt es dafür auch eine Lösung?
Danke und Gruß
Sebbo
Hallo Sebbo,
probier mal so:
Code:
Sub Kopieren_2()
Dim rngQ As Range, rngZ As Range
Dim i As Long
Set rngQ = Range("B2")
Set rngZ = Range("D2")
rngZ.Value = rngQ.Value
rngZ.Interior.Pattern = rngQ.Interior.Pattern
rngZ.Interior.PatternTintAndShade = rngQ.Interior.PatternTintAndShade
If Not rngQ.Interior.Gradient Is Nothing Then
rngZ.Interior.Gradient.ColorStops.Clear
rngZ.Interior.Gradient.Degree = rngQ.Interior.Gradient.Degree
For i = 1 To rngQ.Interior.Gradient.ColorStops.Count
rngZ.Interior.Gradient.ColorStops.Add i - 1
rngZ.Interior.Gradient.ColorStops(i).Color = rngQ.Interior.Gradient.ColorStops(i).Color
rngZ.Interior.Gradient.ColorStops(i).TintAndShade = rngQ.Interior.Gradient.ColorStops(i).TintAndShade
Next i
Else
rngZ.Interior.Color = rngQ.Interior.Color
End If
End Sub
Gruß Uwe
Hallo Uwe,
ich kann dir gar nicht genug danken! Echt toll wie einem hier im Forum immer geholfen wird.
Der Code funktionert super! Das Makro macht genau das was ich mir erhofft/gewünscht habe.
Nochmals danke und noch einen schönen Abend!
Viele Grüße
Sebbo
Hallo Sebbo,
da der letzte Code sehr speziell auf das von Dir genannte Format ausgelegt ist und nicht alle möglichen weiteren Varianten abdeckt, wäre vielleicht doch die PasteSpecial-Methode vorzuziehen:
Code:
Sub Kopieren_3()
Dim rngQ As Range, rngZ As Range
Set rngQ = Range("B2")
Set rngZ = Range("D7")
rngQ.Copy
rngZ.PasteSpecial Paste:=xlPasteValues
rngZ.PasteSpecial Paste:=xlPasteAllMergingConditionalFormats
Application.CutCopyMode = False
End Sub
Gruß Uwe