Bedingte Formatierung beim Kopieren beibehalten

[Sebbo]

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

[schauan]

Hallöchen,

Du könntest in Deinem Makro die Farben einzeln übertragen oder die bedingte Formatierung neu setzen.

[Kuwer]

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

[Sebbo]

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

[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

[Kuwer]

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

[Sebbo]

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

[Kuwer]

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