Zelle suchen, mit ausgeben danebende zelle
15.11.2014 17:46:36
dieter
Ich habe in Tabelle1 die Zelle C1 wo ich den Text suchen lasse in der Tabelle sortiert unter A. Die gefundenen werden mir dann auch in Tabelle1 alle ab C3 nach unten aufgelistet von Tabelle sortiert A.
Ich bekomme es aber nicht hin das er mir auch dann was in dem gefundenen mir die Spalte B mit in dem gefundenen zu übergeben ( kopieren ) Das müsste dann in Spalt D stehen.
Ich hoffe konnte mich genügend ausdrücken.
unten mein Code:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Address(0, 0) "C1" Then Exit Sub
Dim Suchbereich As Range
Dim Suchbegriff As Variant
Dim D As Range
Dim FindAddr As String
Dim lRow As Long
Dim lngLast As Long
Set Suchbereich = Worksheets("sortiert").[a:a]
Suchbegriff = Worksheets("Tabelle1").Range("C1").Text
lngLast = Worksheets("Tabelle1").Cells(Rows.Count, 3).End(xlUp).Row
lRow = 3
Worksheets("Tabelle1").Range("C3:C" & lngLast + 1).Clear
With Suchbereich
Set D = .Find(Suchbegriff, lookat:=xlPart, MatchCase:=False)
If Not D Is Nothing Then
FindAddr = D.Address
Do
Worksheets("Tabelle1").Range("C" & lRow) = D
lRow = lRow + 1
Set D = .FindNext(D)
Loop While Not D Is Nothing And D.Address FindAddr
End If
End With
lngLast = Worksheets("Tabelle1").Cells(Rows.Count, 3).End(xlUp).Row
Worksheets("Tabelle1").Range("C2").Value = lngLast - 2 & " Treffer gefunden"
End Sub
Ich danke schon mal im voraus der Hilfe
Mfg.
dieter