AW: Zellfarbe kopieren
22.01.2025 19:30:41
Piet
Hallo
schöne Lösungen über Tastatur oder mit Rechtsklick, gute Idee. Bei großen Bereichen aber Zeitaufwendig.
Kai Pflaume, Sendung - "Wer weiss denn sowas": --> Wir haben da mal was vorbereitet!
Ich konnte es mir nicht verkneifen das per VBA eleganter zu lösen. Einfach über einen Button!
Das Makro setzt den -selektierten Copybereich- voraus und ruft eine InputBox für die Zieladresse auf.
Dann werden die Werte kopiert, und die Innenfarben 1:1 ausgefüllt.
mfg Piet
Sub Werte_plusFarben_kopieren()
Dim Farbe As Long 'für Color
Dim s As Integer, z As Integer
Dim col As Integer, rw As Integer
Dim QBereich As String, ZAdr As String
ZAdr = InputBox("Bitte die Zieladresse angeben")
If ZAdr = Empty Then Exit Sub
'Quellbereich Adresse notieren
QBereich = Selection.Address
Selection.Copy 'Bereich kopieren
Range(ZAdr).PasteSpecial xlPasteValues
Application.CutCopyMode = False
'1.Zeile und 1.Spalte notieren
rw = Selection.Cells(1, 1).Row
col = Selection.Cells(1, 1).Column
'Innenfarbe 1:1 ausfüllen
For Each AC In Range(QBereich)
Farbe = AC.Interior.Color
If Farbe > 0 Then
z = AC.Row - rw - 1 'Offset berechnen
s = AC.Column - col - 1
Range(ZAdr).Cells(z, s).Interior.Color = Farbe
End If
Next AC
End Sub