AW: Code Wert verdoppeln
04.11.2018 10:41:52
Leonard
Servus Herbert,
besten Dank für den Code.
stelle ich den vor oder nach dem Code (vom Forum-Kollegen erstellt) welcher bereits vorhanden ist?
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Fehler
If Target.Address = "$A$1" Then
Dim RNG1 As Range, RNG2 As Range
Set RNG1 = Range("B10:G150") 'Bereich-1 nach dem sortiert wird
Set RNG2 = Range("L10:O150") 'Bereich-2 nach dem sortiert wird
ActiveSheet.Unprotect "LHT" 'Passwort f?r Zellenschutz
Application.EnableEvents = False
With ActiveWorkbook.Worksheets("Arbeitsprozesse + Zeit").Sort
'Bereich-1
.SortFields.Clear
.SortFields.Add(RNG1.Resize(, 1), xlSortOnCellColor, _
xlAscending, , xlSortNormal).SortOnValue.Color _
= RGB(196, 215, 155) 'Farbcode nachdem sortiert wird
.SetRange RNG1
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
'Bereich-2
.SortFields.Clear
.SortFields.Add(RNG2.Resize(, 1), xlSortOnCellColor, _
xlAscending, , xlSortNormal).SortOnValue.Color _
= RGB(196, 215, 155)
.SetRange RNG2
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveSheet.Protect "LHT" 'Passwort f?r Zellenschutz
End If
'*** Fehlerbehandlung
Err.Clear
Fehler:
Application.EnableEvents = True
If Err.Number 0 Then MsgBox "Fehler: " & _
Err.Number & vbLf & Err.Description: Err.Clear
End Sub