Suche und Zeilen kopieren
03.02.2004 13:41:13
Tobster
mein Code sieht folgendermaßen aus:
Public
Sub suche()
Dim varBereich As Range
Dim varSuchstring As Variant
Dim varZelleninhalt As Variant
Dim intBlatt As Integer
Dim lngZielzeile As Long
Dim varBlattname As Variant
Dim lngZeile As Long
Dim strTabName As String
Dim intFirst As Integer
Dim zelle As Range
Set varBereich = Application.InputBox("Bitte markieren Sie den zu durchsuchenden Bereich:", _
Type:=8)
varSuchstring = InputBox("Nach welchem Begriff soll gesucht werden:")
intBlatt = 0
lngZielzeile = 1
intFirst = 0
strTabName = ActiveSheet.Name
For Each zelle In varBereich
If intFirst = 0 Then lngZeile = Right(zelle.Address, 1) Else lngZeile = lngZeile + 1
intFirst = 1
If IsEmpty(zelle) Then GoTo weiter
If Not InStr(zelle.Value, varSuchstring) < 1 Then
If intBlatt = 0 Then
varBlattname = (Sheets.Count + 1)
Set neuesBlatt = Sheets.Add(Type:=xlWorksheet)
neuesBlatt.Name = varBlattname
intBlatt = 1
zelle.EntireRow.Copy Worksheets(varBlattname).Rows(lngZielzeile)
lngZielzeile = lngZielzeile + 1
Else
zelle.EntireRow.Copy Worksheets(varBlattname).Rows(lngZielzeile)
lngZielzeile = lngZielzeile + 1
End If
End If
weiter:
Next zelle
End Sub
Es funktioniert auch alles soweit, aber nachdem das neue Tabellenblatt angelegt wurde, steht nix drin, obwohl es so sein sollte. Woran könnte das liegen?
Gruß
Tobi