AW: Suchen, Auswählen und Ausgeben mehrerer Zellen
28.02.2006 13:22:54
Heiko
Hallo Stephan,
z.B. so:
Sub ZusammenKopieren()
Dim strSuchtext As String, strQuellTabelle As String, strZielTabelle As String
Dim lngI As Long, lngN As Long
' Namen der Quelltabelle anpassen
strQuellTabelle = "Tabelle1"
strSuchtext = InputBox("Bitte geben Sie den Suchtext ein !", " Suchtext", "Shaft")
If strSuchtext = "" Or strSuchtext = "False" Or strSuchtext = "Falsch" Then
Exit Sub
End If
Sheets.Add After:=Worksheets(Worksheets.Count)
On Error Resume Next
' Wenn schon eine Tabelle mit dem Namen Gesammelte_Daten vorhanden ist dann bleibt der von
' EXCEL vergebene Name z.B. Tabelle12 halt erhalten.
ActiveSheet.Name = "Gesammelte_Daten"
On Error GoTo 0
strZielTabelle = ActiveSheet.Name
lngN = 1
With Worksheets(strQuellTabelle)
For lngI = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
If InStr(.Cells(lngI, 1), strSuchtext) > 0 Then
.Cells(lngI, 1).EntireRow.Copy Destination:=Worksheets(strZielTabelle).Rows(lngN)
lngN = lngN + 1
End If
Next lngI
End With
End Sub
Gruß Heiko
PS: Rückmeldung wäre nett !