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
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen