Suchen und kopieren
24.05.2005 09:02:20
Holger
Wie muß der Teil,"'Zelle mit Suchkriterium in Tabelle2 kopieren",
des folgende Codes so geändert werden damit nicht das Suchhriterium sonder die
Zelle rechts neben dem Suchkriterium kopiert wird.
Danke für die Hilfe !!
Sub LG_suchen()
Dim rngAct As Range
Dim strFindFirst As String
Dim intLoopCount As Integer
Dim varFind As Variant
'Begrenzung des zu durchsuchenden Bereichs
'auf Spalte C
With ActiveSheet.Columns(3)
'1. Übereinstimmung finden
Set varFind = .Find(What:=Range("A1"), After:=Range("C1"), _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False)
If Not varFind Is Nothing Then
'1. Zelle für das Beenden der Do-Loop-Schleife merken
strFindFirst = varFind.Address
Do
'Zelle mit Suchkriterium in Tabelle2 kopieren.
Range(varFind.Address).Copy _
Destination:=Sheets("Tabelle2").Range("A1")
'nächste Zelle suchen
Set varFind = .FindNext(varFind)
'Schleife ausführen, solange das Suchkriterium gefunden
'wird und bis letztendlich wieder die 1. Zelle erreicht ist
'(sonst würde es in einer Endlosschleife enden)
Loop While Not varFind Is Nothing And varFind.Address <> strFindFirst
End If
End With
End Sub
Anzeige