ich will nach bestimmten Zellinhalten suchen und dann die ganze Zeile in ein anderes Blatt kopieren. In der Recherche fand ich den passenden Code.
Die Überschriftenzeile und die erste "SuchZeile" wird ins neue Blatt kopiert, dann hängt sich Excel auf. Warum nur ?.
Dank für jeden Hinweis.
Peter
Sub ArtikelSuchenKopieren()
'Sucht einen Begriff in einem bestimmten Blatt,
'und kopiert die Ergebnisse in ein anderes Blatt
Static Suchbegriff As String
Dim Zelle, ErsteAdresse, ArbeitsblattDaten, ArbeitsblattErgebnis As String
Dim LetzteZelle, intCount As Integer
Application.ScreenUpdating = False
ArbeitsblattDaten = "Tabelle1" 'Tabelle, in der gesucht wird
ArbeitsblattErgebnis = "Tabelle2" 'Tabelle, in der die Ergebnisse stehen
Sheets(ArbeitsblattErgebnis).Cells.Clear 'Alte Tabelleninhalte löschen
Suchbegriff = InputBox(Prompt:="Bitte Suchbegriff eingeben:", Default:=Suchbegriff)
If Suchbegriff = "" Then Exit Sub
Sheets(ArbeitsblattDaten).Activate
Rows(1).Copy 'Überschriftenzeile kopieren ...
Sheets(ArbeitsblattErgebnis).Select
Range("a1").Select
ActiveSheet.Paste '... und in dem anderen Tabellenblatt einfügen
Sheets(ArbeitsblattDaten).Activate
With ActiveSheet.UsedRange
Set Zelle = .Find(Suchbegriff, LookIn:=xlValues)
If Not Zelle Is Nothing Then
ErsteAdresse = Zelle.Address
Do
LetzteZelle = Sheets(ArbeitsblattErgebnis).Cells(Cells.Rows.Count, 1).End(xlUp).Row
Rows(Zelle.Row).Copy
Sheets(ArbeitsblattErgebnis).Select
Cells(LetzteZelle + 1, 1).Select
ActiveSheet.Paste
Sheets(ArbeitsblattDaten).Activate
Set Zelle = .FindNext(Zelle)
Loop While Not Zelle Is Nothing And Zelle.Address <> ErsteAdresse
End If
Sheets(ArbeitsblattErgebnis).Select
Range("a1").Select
End With
Application.CutCopyMode = xlCopy
Application.ScreenUpdating = True
End Sub