AW: Suche nach Begriff in Spalte und dann neues Blatt
03.06.2010 14:09:33
Josef
Hallo Chris,
mein Code sucht in Spalte "H", so wie du es gewünscht hast.
Im neuen Code kannst du die Suchspalte leichter anpassen, siehe Kommentar.
' **********************************************************************
' Modul: Modul2 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Sub SearchAndList()
Dim objShSrc As Worksheet, objShTarget As Worksheet
Dim rng As Range, strFirst As String, strSearch As String
Dim lngRow As Long, lngSearchColumn As Long
strSearch = InputBox("Bitte Suchbegriff eingeben!", "Suche")
lngRow = 3
lngSearchColumn = 8 'Spalte in welcher gesucht wird 8 = "H"
If strSearch <> "" Then
Set objShSrc = Sheets("Tabelle1") 'Tabelle in welcher gesucht wird
Set objShTarget = ThisWorkbook.Worksheets.Add(after:=objShSrc)
objShTarget.Name = "Search_" & Format(Now, "yymmdd-hhmmss")
Set rng = objShSrc.Columns(lngSearchColumn).Find(What:=strSearch, LookIn:=xlValues, _
LookAt:=xlPart, after:=objShSrc.Cells(Rows.Count, lngSearchColumn))
If Not rng Is Nothing Then
strFirst = rng.Address
objShTarget.Cells(1, 1) = "Die Suche nach '" & strSearch & "' ergab folgende Treffer!"
Do
With objShTarget
.Hyperlinks.Add Anchor:=.Cells(lngRow, 1), _
Address:="", _
SubAddress:="'" & objShSrc.Name & "'!" & rng.Address, _
TextToDisplay:=rng.Address(0, 0)
lngRow = lngRow + 1
End With
Set rng = objShSrc.Columns(8).FindNext(rng)
Loop While Not rng Is Nothing And strFirst <> rng.Address
Else
objShTarget.Cells(1, 1) = "Die Suche nach '" & strSearch & "' ergab keinen Treffer!"
End If
End If
Set rng = Nothing
Set objShSrc = Nothing
Set objShTarget = Nothing
End Sub
Gruß Sepp