AW: Nur Rahmen und nur Füllfarbe kopieren
12.09.2014 19:20:22
Lutz
Hallo Yummi,
vielen lieben Dank, ich habe es jetzt so gelöst:
Function Set_BordersAndColor(rngSource As Range, rngdest As Range)
Dim i As Integer
For i = 7 To 10
With rngdest.Borders(i)
.LineStyle = xlNone 'hier löscht Du den Rahmen der Zielzelle erst ab
If rngSource.Borders(i).LineStyle xlNone Then
.LineStyle = rngSource.Borders(i).LineStyle
.Weight = rngSource.Borders(i).Weight
.Color = rngSource.Borders(i).Color
End If
End With
rngdest.Interior.Color = rngSource.Interior.Color
Next
End Function
Function Set_Borders(rngSource As Range, rngdest As Range)
Dim i As Integer
For i = 7 To 10
With rngdest.Borders(i)
.LineStyle = xlNone 'hier löscht Du den Rahmen der Zielzelle erst ab
If rngSource.Borders(i).LineStyle xlNone Then
.LineStyle = rngSource.Borders(i).LineStyle
.Weight = rngSource.Borders(i).Weight
.Color = rngSource.Borders(i).Color
End If
End With
Next
End Function
Function Set_Color(rngSource As Range, rngdest As Range)
rngdest.Interior.Color = rngSource.Interior.Color
End Function
Sub test()
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = ActiveSheet.Cells(3, 2)
Set rng2 = ActiveSheet.Cells(3, 5)
Call Set_BordersAndColor(rng1, rng2) 'so einen Aufruf mit den Zellen die Du benötigst _
baust Du in dein Makro ein.
End Sub
Sub AtestBaC()
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = ActiveCell
Set rng2 = Application.InputBox("Select a range", "Get Range", Type:=8)
Call Set_BordersAndColor(rng1, rng2)
End Sub
Sub AtestB()
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = ActiveCell
Set rng2 = Application.InputBox("Select a range", "Get Range", Type:=8)
Call Set_Borders(rng1, rng2)
End Sub
Sub AtestC()
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = ActiveCell
Set rng2 = Application.InputBox("Select a range", "Get Range", Type:=8)
Call Set_Color(rng1, rng2)
End Sub
Man steht dann schon in der Quellzelle und wählt den Zielbereich aus.
Und ich habe mal getrennt in Rahmen und Farbe, nur Farbe und Rahmen.
Also vielen lieben Dank und noch ein schönes Wochenende,
viele Grüße Lutz