Option
Explicit
Public
Sub
test()
Const
SEARCH_COLUMN
As
Long
= 3
Const
COPY_COLUMN
As
Long
= 2
Dim
avntSource()
As
Variant
, avntTarget()
As
Variant
Dim
ialngCount
As
Long
, ialngRow
As
Long
Dim
lngLastRow
As
Long
, lngIncr
As
Long
Dim
vntInput
As
Variant
vntInput = Application.InputBox(Prompt:=
"Herr Ober, bitte Zahlen..;-)"
, _
Title:=
"Datensuche"
, Type:=1)
If
VarType(vntInput) = vbBoolean
And
vntInput =
False
Then
Exit
Sub
avntSource() = Tabelle1.UsedRange.Value
For
ialngRow = 1
To
UBound(avntSource)
If
avntSource(ialngRow, SEARCH_COLUMN) = vntInput
Then
ReDim
Preserve
avntTarget(1, ialngCount)
As
Variant
avntTarget(0, ialngCount) = avntSource(ialngRow, COPY_COLUMN)
avntTarget(1, ialngCount) = avntSource(ialngRow, SEARCH_COLUMN)
ialngCount = ialngCount + 1
End
If
Next
If
ialngCount = 0
Then
Call
MsgBox(Prompt:=
"Die Zahl wurde nicht gefunden..!"
, _
Buttons:=vbExclamation, Title:=
"Datensuche"
)
Else
With
Tabelle2
lngLastRow = .Cells(.Rows.Count, 1).
End
(xlUp).Row
lngIncr = IIf(lngLastRow = 1, 0, 1)
.Range(.Cells(lngLastRow + lngIncr, 1), _
.Cells(UBound(avntTarget, 2) + lngLastRow + lngIncr, 2)).Value = _
WorksheetFunction.Transpose(avntTarget())
End
With
End
If
End
Sub