Private
Sub
Worksheet_Change(
ByVal
Target
As
Range)
Dim
selectedOption
As
String
Dim
searchData
As
Variant
Dim
lastRow
As
Long
If
Target.Address(0, 0) =
"G4"
And
Target.Value <>
""
Then
selectedOption =
Me
.Range(
"G4"
).Value
With
Sheets(
"Rohdaten"
)
searchData = Application.Match(selectedOption, .Columns(1), 0)
If
IsNumeric(searchData)
Then
Application.EnableEvents =
False
Me
.Range(
"J13:J17"
) = WorksheetFunction.Transpose(.Cells(searchData, 2).Resize(1, 5))
Application.EnableEvents =
True
Else
lastRow = .Cells(.Rows.Count, 1).
End
(xlUp).Row + 1
.Cells(lastRow, 1).Value = selectedOption
Application.EnableEvents =
False
Me
.Range(
"J13:J17"
).ClearContents
Application.EnableEvents =
True
End
If
End
With
Else
If
Not
Intersect(Target,
Me
.Range(
"J13:J17"
))
Is
Nothing
Then
If
Me
.Range(
"G4"
).Value <>
""
Then
With
Sheets(
"Rohdaten"
)
searchData = Application.Match(
Me
.Range(
"G4"
).Value, .Columns(1), 0)
If
IsNumeric(searchData)
Then
.Cells(searchData, 2).Resize(1, 5).Value = WorksheetFunction.Transpose(
Me
.Range(
"J13:J17"
).Value)
End
If
End
With
End
If
End
If
End
If
End
Sub