Hallo Hajo!
Danke für Deine Antwort!
Habe jetzt den Code mit den folgenden Zeilen (siehe ' ) ergänzt.
Leider passiert jetzt gar nuichts mehr. Es wird keine Aktion durchgeführt. Wo hhabe ich bitte den Fehler gemacht?
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Long, wsB As Worksheet, wsC As Worksheet
Dim efz As Long, k As Range
Application.EnableEvents = False
If Target.Column = 7 And Target.Row > 1 Then
If Target.Count = 1 Then
'Set wsB = Sheets("Lotus Notes")
'Set wsC = Sheets("Binf neu (2)")
r = Target.Row - 1
Range(Cells(r, 1), Cells(r, 6)).Copy _
Range(Cells(r + 1, 1), Cells(r + 1, 6))
' wsB.Range(wsB.Cells(r, 1), wsB.Cells(r, 6)).Copy _
' wsB.Range(wsB.Cells(r + 1, 1), wsB.Cells(r + 1, 6))
' wsC.Range(wsC.Cells(r, 1), wsC.Cells(r, 9)).Copy _
' wsC.Range(wsC.Cells(r + 1, 1), wsC.Cells(r + 1, 9))
Range(Cells(r, 8), Cells(r, 9)).Copy _
Range(Cells(r + 1, 8), Cells(r + 1, 9))
' wsB.Range(wsB.Cells(r, 7), wsB.Cells(r, 12)).Copy _
wsB.Range(wsB.Cells(r + 1, 7), wsB.Cells(r + 1, 12))
' wsC.Range(wsC.Cells(r, 22), wsC.Cells(r, 26)).Copy _
wsC.Range(wsC.Cells(r + 1, 22), wsC.Cells(r + 1, 26))
' Set wsB = Nothing
' Set wsC = Nothing
End If
'End If
ElseIf Target.Row > 1 Then
With Worksheets("tabelle1")
Select Case Target.Column
Case 1
Set k = .Columns(104).Find(Target.Row, LookAt:=xlWhole)
If Not k Is Nothing Then
.Cells(k.Row, 4).Value = Target
Else
efz = .Cells(Rows.Count, 4).End(xlUp).Row + 1
.Cells(efz, 4).Value = Target
.Cells(efz, 104).Value = Target.Row
End If
Case 2
Set k = .Columns(110).Find(Target.Row, LookAt:=xlWhole)
If Not k Is Nothing Then
.Cells(k.Row, 5).Value = Target
Else
efz = .Cells(Rows.Count, 5).End(xlUp).Row + 1
.Cells(efz, 5).Value = Target & " - " & Target.Offset(0, 1)
'.Cells(efz, 5).Value = Target
.Cells(efz, 110).Value = Target.Row
End If
Case 4
Set k = .Columns(105).Find(Target.Row, LookAt:=xlWhole)
If Not k Is Nothing Then
.Cells(k.Row, 6).Value = Target
Else
efz = .Cells(Rows.Count, 6).End(xlUp).Row + 1
.Cells(efz, 6).Value = Target
.Cells(efz, 105).Value = Target.Row
End If
Case 5
Set k = .Columns(111).Find(Target.Row, LookAt:=xlWhole)
If Not k Is Nothing Then
.Cells(k.Row, 7).Value = Target
Else
efz = .Cells(Rows.Count, 7).End(xlUp).Row + 1
.Cells(efz, 7).Value = Target & " " & Target.Offset(0, 1)
'.Cells(efz, 5).Value = Target
.Cells(efz, 111).Value = Target.Row
End If
Case 7
Set k = .Columns(106).Find(Target.Row, LookAt:=xlWhole)
If Not k Is Nothing Then
.Cells(k.Row, 8).Value = Target
Else
efz = .Cells(Rows.Count, 8).End(xlUp).Row + 1
.Cells(efz, 8).Value = Target
.Cells(efz, 106).Value = Target.Row
End If
Case 8
Set k = .Columns(112).Find(Target.Row, LookAt:=xlWhole)
If Not k Is Nothing Then
.Cells(k.Row, 9).Value = Target
Else
efz = .Cells(Rows.Count, 9).End(xlUp).Row + 1
.Cells(efz, 9).Value = Target & " " & Target.Offset(0, 1)
'.Cells(efz, 5).Value = Target
.Cells(efz, 112).Value = Target.Row
End If
End Select
End With
End If
Set k = Nothing
Application.EnableEvents = True
End Sub