Makro anpassen
wafi
Folgendes Problem hat sich gestellt, mit dem ich ohne Hilfe nicht zurecht komme.
Ich verwende dieses Makro schon lange und es funktioniert perfekt.
Nun möchte ich es aber innerhalb einer Tabelle zweimal verwenden.
Wenn ich im Bereich C15:C192 eine Eingabe mache, dann sollte der Bereich B15:GK192 sortiert werden.
Mache ich aber eine Eingabe im Bereich C198:C375 , dann sollte im Bereich B198:GK375 sortiert werden.
Setze ich das Makro zweimal ein und passe die Bereiche richtig an, funktioniert nur das Erste.
Es ist mir auch klar das das so nicht klappen kann, bestimmt muß vorher schon entschieden werden
welches Makro ausgeführt werden soll.
Also, wenn Eingabe im Bereich x bis x dann Makro 1 ausführen, wenn Eingabe im Bereich y bis y dann Makro 2 aufrufen.
Kann mir hier jemand weiter helfen.
Vielen Dank
Gruß
wafi
Private Sub Worksheet_Change(ByVal Target As Range)
Dim RaBereich As Range, RaZelle As Range
' alle Buchstaben Groß im Bereich ("C15:C192")
Application.EnableEvents = False
' Bereich der Wirksamkeit
Set RaBereich = Range("C15:C192")
Application.EnableEvents = False
ActiveSheet.Unprotect
For Each RaZelle In Range(Target.Address)
If Not Intersect(RaZelle, RaBereich) Is Nothing Then
RaZelle.Value = UCase(RaZelle.Value)
End If
Next RaZelle
Application.EnableEvents = True
' automatisch sortieren bei Eingabe im Bereich C15:C192
Set RaBereich = Nothing
Set RaBereich = Range("C15:C192")
For Each RaZelle In Range(Target.Address)
If Not Intersect(Target, RaBereich) Is Nothing Then ' Zelle ist im Bereich
Range("B15:GK192").Sort Key1:=Range("C15"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
Exit For
End If
Next RaZelle
ActiveSheet.Protect
Application.EnableEvents = False
' Bereich der Wirksamkeit
Set RaBereich = Range("D15:D192")
' ActiveSheet.Unprotect
Application.EnableEvents = False
For Each RaZelle In Range(Target.Address)
If Not Intersect(RaZelle, RaBereich) Is Nothing Then
If RaZelle "" Then
RaZelle.Value = UCase(Mid(RaZelle.Value, 1, 1)) _
& LCase(Mid(RaZelle.Value, 2, Len(RaZelle.Value) - 1))
End If
End If
Next RaZelle
Application.EnableEvents = True
' ActiveSheet.protect
Set RaBereich = Nothing
End Sub