Automatischer Zelleneintrag
09.06.2021 15:47:28
MaAs
ich habe etwas recherchiert und für mich einen passenden Code gefunden, den ich soweit angepasst habe. Es geht um folgendes: Ich möchte, wenn ich in einer bestimmten Spalte die Zahlen 1 bis 6 eintrage, dass die benachbarte Zelle mit einem bestimmten Wert versehen wird. Das klappt soweit auch, jedoch nur wenn ich manuell den Wert 1 bis 6 händisch eintippe. Wenn die Werte reinkopiert werden, klappt das nicht mehr. Kann man diesen Code irgendwie anpassen? Leider verstehe ich nicht jeden Befehl, sodass ich gar nicht weiß, wo ich da was manipulieren kann. Ein weiteres Problem habe ich wenn ich den Wert 1 bis 6 lösche, der Wert in der benachbarten Zelle bleibt stehen, das sollte nicht sein.
Vielen Dank an alle hilfsbereiten Menschen!
Liebe Grüße
Mariam
Private Sub Worksheet_Change(ByVal Target As Range)
Const myCol = 3
If Not Intersect(Target, Columns(myCol)) Is Nothing Then
a = Worksheets("Tabelle3").Range("B1").Value
b = Worksheets("Tabelle3").Range("B2").Value
c = Worksheets("Tabelle3").Range("B3").Value
d = Worksheets("Tabelle3").Range("B4").Value
e = Worksheets("Tabelle3").Range("B5").Value
f = Worksheets("Tabelle3").Range("B6").Value
On Error Resume Next
If Intersect(Target, Columns(myCol)).Value = 1 Then
Target.Offset(, 1) = IIf(Target(1) = vbNullString, vbNullString, a)
Else
If Intersect(Target, Columns(myCol)).Value = 2 Then
Target.Offset(, 1) = IIf(Target(1) = vbNullString, vbNullString, b)
Else
If Intersect(Target, Columns(myCol)).Value = 3 Then
Target.Offset(, 1) = IIf(Target(1) = vbNullString, vbNullString, c)
Else
If Intersect(Target, Columns(myCol)).Value = 4 Then
Target.Offset(, 1) = IIf(Target(1) = vbNullString, vbNullString, d)
Else
If Intersect(Target, Columns(myCol)).Value = 5 Then
Target.Offset(, 1) = IIf(Target(1) = vbNullString, vbNullString, e)
Else
If Intersect(Target, Columns(myCol)).Value = 6 Then
Target.Offset(, 1) = IIf(Target(1) = vbNullString, vbNullString, f)
End If
End If
End If
End If
End If
End If
End If
End Sub