AW: Zeilen Automatisch Kopieren
25.12.2019 18:18:17
Nepumuk
Hallo Hans,
so?
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'sprung Zelle A nach C seh Case
If Target.Count = 1 Then
If Target.Row >= 2 And Target.Row <= 8000 Then
Select Case Target.Column
Case 1
Target.Offset(0, 2).Select
Case 3
If Target.Row < 8000 Then
With Worksheets("Protokol").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
.Offset(0, 3).Resize(1, 3).Value = _
Range(Cells(Target.Row, 1), Cells(Target.Row, 3)).Value
.Value = Target.Row
.Offset(0, 1).Value = Date
.Offset(0, 2).Value = Time
End With
Target.Offset(1, -2).Select
End If
End Select
End If
End If
'---------------------------------------------------------------
'sverweis aus tab1
Dim var As Variant
If Target.Column = 1 Then
With Application
var = .VLookup(Target.Value, _
Worksheets("tab1").Columns("A:B"), 2, 0)
If Not IsError(var) Then
Application.EnableEvents = False
On Error GoTo ERRORHANDLER
Target.Offset(0, 1) = .VLookup(Target.Value, _
Worksheets("tab1").Columns("A:C"), 2, 0)
'Target.Offset(0, 2) = .VLookup(Target.Value, _
'Worksheets("tab1").Columns("A:D"), 3, 0)
'Target.Offset(0, 3) = .VLookup(Target.Value, _
'Worksheets("tab1").Columns("A:D"), 4, 0)
End If
End With
End If
ERRORHANDLER:
Application.EnableEvents = True
End Sub
Gruß
Nepumuk