habe meine Anfrage im Excelfile beschrieben.
Danke und schöne Ostern.
Option Explicit
'Code im VBA-Editor unter dem Blatt "Neue Teilenummer laden"
Private Sub Worksheet_Change(ByVal Target As Range)
Dim varGapsCode As Variant, rngZelle As Range
Dim wksGapsCode As Worksheet, Zeile As Long
Dim wksTNR As Worksheet
Set wksGapsCode = Worksheets("Gapscode")
Set wksTNR = Me
If Target.Column = 17 And Target.Row > 1 And Target.Cells.Count = 1 Then
varGapsCode = Target.Value
With wksGapsCode
Set rngZelle = .Columns(1).Find(What:=varGapsCode, LookIn:=xlValues, lookat:=xlWhole)
If rngZelle Is Nothing Then
MsgBox "Eingegben GapsCode ist in Liste nicht vorhanden"
Else
Application.EnableEvents = False
'korrigiert ggf Fehler bei Groß-Kleinschreibung bei Eingabe
wksTNR.Cells(Target.Row, 17).Value = .Cells(rngZelle.Row, 1).Value
'Werte für GapsCode übertragen
wksTNR.Cells(Target.Row, 5).Value = .Cells(rngZelle.Row, 2).Text 'FY
wksTNR.Cells(Target.Row, 6).Value = .Cells(rngZelle.Row, 3).Text 'LY
wksTNR.Cells(Target.Row, 7).Value = .Cells(rngZelle.Row, 4).Value 'Book
wksTNR.Cells(Target.Row, 8).Value = .Cells(rngZelle.Row, 5).Value 'MS
wksTNR.Cells(Target.Row, 9).Value = .Cells(rngZelle.Row, 6).Text 'MB
Application.EnableEvents = True
End If
End With
End If
End Sub