AW: Nachfrage..
17.10.2018 10:21:02
UweD
Hallo nochmal
in der letzten Datei von dir ist nichts in I-J vorhanden (du schreibst J-M)
habe den Teil dubliziert
Microsoft Excel Objekt Tabelle2
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Fehler
If Target.Address = "$B$1" Then
Dim RNG1 As Range, RNG2 As Range
Set RNG1 = Range("B7:G106")
Set RNG2 = Range("I7:J55") 'anpassen
ActiveSheet.Unprotect "ABC"
Application.EnableEvents = False
With ActiveWorkbook.Worksheets("Arbeitsprozesse + Zeit").Sort
'Bereich1
.SortFields.Clear
.SortFields.Add(RNG1.Resize(, 1), xlSortOnCellColor, _
xlAscending, , xlSortNormal).SortOnValue.Color _
= RGB(196, 215, 155)
.SetRange RNG1
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
'Bereich2
.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 "ABC"
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
LG UweD