Hallo Sarah,
das könnte man z.B. mit nachfolegndem Makro realisieren. Hier wird das aktuelle Tabellenblatt nach dem Text, der in dem Eingabefenster eingetragen wurde, durchsucht. Bei Übereinstimmungen wird die gesamte Zeile der Übereinstimmung in ein neu erzeugtes Tabellenblatt kopiert.
Kopiere das Makro in ein StandardModul und starte es z.B. über eine Befehlsschaltfläche
Teste das Makro aber bitte in einer Testdatei und nicht gleich in Deiner Originaldatei.
Option Explicit
Sub Duplikate_finden_und_kopieren()
Dim rngSuchbereich As Range
Dim strAddresse As String
Dim objAktSheet As Object
Dim objNewSheet As Object
Dim varSuchtext As String
varSuchtext = InputBox("Bitte Scuchbegriff eintragen")
If varSuchtext = "" Or varSuchtext = False Then Exit Sub
'Tabellenblatt "Auswertung" löschen
On Error Resume Next
Application.DisplayAlerts = False
Sheets("Auswertung").Delete
Application.DisplayAlerts = True
On Error GoTo 0
Set objAktSheet = ActiveSheet
'Neues Tabellenblatt mit denm Namen "Auswertung" anlegen
Set objNewSheet = Application.Sheets.Add
objNewSheet.Name = "Auswertung"
'Bereich durchsuchen und bei Übereinstimmung Zeile kopieren und in Blatt "Auswertung" einfügen
With objAktSheet.Range("A1:IV65536")
Set rngSuchbereich = .Find(What:=varSuchtext, LookIn:=xlValues)
If Not rngSuchbereich Is Nothing Then
strAddresse = rngSuchbereich.Address
Do
objAktSheet.Rows(rngSuchbereich.Row).Copy _
objNewSheet.Cells(objNewSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1, 1)
Set rngSuchbereich = .FindNext(rngSuchbereich)
Loop While Not rngSuchbereich Is Nothing And rngSuchbereich.Address <> strAddresse
End If
End With
Set objAktSheet = Nothing
Set objNewSheet = Nothing
End Sub
Solltest Du nicht wissen, wie Du den Code in Deine Datei bekommst, dann schau mal auf
meiner HP in der
Rubrik Anleitungen und dort dann in der
Anleitungsnummer 3 nach. Dort stelle ich dazu eine bebilderte Anleitung zur Verfügung, die Dir sicherlich helfen wird.
Bei Fragen melde Dich.
MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]
