bestimmte Zeilen durch Makro auflisten

[Kuwer]

Hallo,

hier das geänderte Makro:

Sub Makro2()
  Dim rngF As Range, rngS As Range
  Dim strS As String
  With Columns(3)
    Set rngS = .Find(What:="TÜV", After:=.Cells(.Cells.Count), LookIn:=xlValues, LookAt _
        :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False)
    Set rngF = Rows(1)
    If Not rngS Is Nothing Then
      strS = rngS.Address
      Do
        Set rngF = Application.Union(rngF, rngS.EntireRow)
        Set rngS = .FindNext(rngS)
        If rngS Is Nothing Then Exit Do
      Loop Until rngS.Address = strS
    End If
  End With
  Set rngS = ActiveCell
  Sheets("Tabelle2").Cells.Delete
  rngF.Select
  Selection.Copy Sheets("Tabelle2").Cells(1)
  rngS.Select
End Sub

Gruß Uwe

[danisound]

Nochmals vielen Dank! Funktioniert jetzt einwandfrei!