Hallo Exelfreaks
Ich habe in meiner Exeltabell-Blatt1- folgenden VBA-Code stehen:
' Zeilen überprüfen und kopieren
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngBer As Range
Dim rngObj As Range
Dim Sh As Worksheet
On Error GoTo Err_Handler
' zu prüfende Zellen als Gesamtbereich festlegen
With Me
Set rngBer = Union(.Range("F8:F50"), .Range("G8:G50"), .Range("I8:I50"), _
.Range("J8:J50"))
End With
' gucken ob change im Zielbereich liegt
If Not Intersect(Target, rngBer) Is Nothing Then
With Target
' wenn ja, Abfrage ob alle Zellen gefüllt sind, wenn eine leer dann raus aus sub
For Each rngObj In rngBer
' nur wenn Zeile stimmt Inhalt prüfen
If rngObj.Row = .Row Then
' wenn Zeile stimmt, aber einer der 4 Checkbereiche leer, dann exit
If rngObj.Value = "" Then
GoTo Exit_This
End If
End If
Next rngObj
' sheetauswahl nach Angabe im Tabellenblatt, Spalte l
' nicht existent wird im err_handler abgearbeitet
Set Sh = Sheets(Right(Cells(.Row, 12), 4))
Application.EnableEvents = False
Application.ScreenUpdating = False
Sh.Unprotect
Me.Unprotect
' Zeile kopieren ins neue Sheet
Rows(.Row).Copy Destination:=Sh.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
' Zeile im Ursprungssheet löschen
Rows(.Row).Delete
Me.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sh.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End With
End If
Exit_This:
Application.EnableEvents = True
Application.ScreenUpdating = True
Set rngBer = Nothing
Set rngObj = Nothing
Set Sh = Nothing
Exit Sub
' Fehlerprüfroutine
Err_Handler:
Select Case Err.Number
Case 9
MsgBox "Das angegebene Tabellenblatt existiert nicht!"
Case Else
MsgBox "Fehler: " & Err.Number & vbLf & Err.Description
End Select
Resume Exit_This
End Sub
' Aufruf eines Kalenders
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim RaBereich As Range
If Target.Count > 1 Then Exit Sub
' Bereich der Wirksamkeit
Set RaBereich = Range("A8:A50, J8:J50, M8:M50")
If Not Intersect(Target, RaBereich) Is Nothing Then
Kalender.Show
ElseIf Target.Row >= 4 And Target.Row <= 7 And Target.Column <= 12 Then
Kalender.Show
End If
' ActiveSheet.protect ("hsxxxx")
Set RaBereich = Nothing
End Sub
Ich möchte jetzt die zur Bearbeitung anstehende Zelle farblich hervorhaben. Hierzu habe ich in einem
Forum folgenden Code gefunden:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Cells.Interior.ColorIndex = xlNone
ActiveCell.Interior.ColorIndex = 6
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells.Interior.ColorIndex = xlNone
ActiveCell.Interior.ColorIndex = 6
End Sub
Wenn ich diesen Code in mein Tabellenblatt einfüge, erhalte ich eine Fehlermeldung. Frage, wie wird dieser Code richtig eingefügt, damit kein Fehler entsteht.
Bin auf dem Gebiet VBA blutiger Anfänjger.
Für die Hilfe Dank im Voraus.
Gruß Horst
