|
Hallo,
na, dann teste mal:
Option Explicit
Public Sub test()
Const SEARCH_COLUMN As Long = 3 '// Deine Suchspalte
Const COPY_COLUMN As Long = 2 '// Deine Kopierspalte
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
Gruß,
|