Ich glaub jetzt hab ich es. Nach diversen Möglichkeiten.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngTreffer As Range
Dim strKey As String
Dim strCol As Integer
On Error GoTo Fehler 'Aussprung bei Error
'nur Spalten B sortieren (Selection überspringen)
If InStr(Target.Address, ":") Then Exit Sub
ActiveSheet.Unprotect Password:="passw"
If Target.Column <> 2 Then Exit Sub
ActiveSheet.Unprotect Password:="passw"
strKey = Target.Value
strCol = Target.Column '** ab Spalte B bis BI sortieren
Range("B18:BB1000").Sort key1:=Range("B18:BB1000"), order1:=xlAscending, Header:=xlYes
ActiveSheet.Protect Password:="passw"
Set rngTreffer = Range("A:BB").Find(what:=strKey, Lookat:=xlWhole)
If Not rngTreffer Is Nothing Then rngTreffer.Select
Exit Sub
Fehler: MsgBox "Taret Fehler aufgetreten"
End Sub
|