|
Hi,
danke, das war ein Fehler, den ich bereits korrigiert habe. Die anderen Punkte sind viel wichtiger. Ich komme nicht weiter...
Hier ist nochmal der aktuelle Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim intLZ As Integer
Dim wsq As Worksheet
Dim wsz As Worksheet
Dim start As Integer
If Target.Column <> 1 Then Exit Sub
If Target.Count > 1 Then Exit Sub
Set wsz = Sheets("Prüfplan")
Set wsq = Sheets("Sonderprüfbedingungen")
intLZ = wsz.Cells(Rows.Count, 8).End(xlUp).Row + 1
Application.EnableEvents = False
If Target.Value = "x" Then
With wsz
.Cells(intLZ, 8).Value = Target.Offset(, 1).Value
'.Cells(intLZ, 9).Value = Target.Offset(, 2).Value
.Cells(intLZ, 5).Value = Target.Offset(, 4).Value
End With
Else
start = wsz.Range("H20:H" & intLZ).Find(what:=Target.Offset(, 1)).Row
With wsz
.Cells(start, 8).Value = ""
'.Cells(start, 9).Value = ""
.Cells(start, 5).Value = ""
End With
End If
Application.EnableEvents = True
Set wsz = Nothing
Set wsq = Nothing
'Set leerzeile = Nothing
End Sub
Dann wollte ich hier noch versuchen, dass sich die Zeilen automatisch löschen, was nicht funktioniert ohne Fehlermeldungen:
Dim leerzeile As Range
On Error Resume Next
Set leerzeile = Sheets("Prüfplan").Range("A20:J200").SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If Not leerzeile Is Nothing Then leerzeile.EntireRow.Delete
|