Excel / VBA: Vorhandenes Sheed nach bestimmten Kriterien durchsuchen und in ein neues Sheed übertragen

Question

Hallo Forum,

ich stehe vor folgendem Problem:
Ich habe eine gegebene Tabelle mit Informationen. Jetzt sollen im ersten Schritt zwei Spalten nach bestimmten Informationen durchsucht werden und wenn deren Inhalt dem Suchkriterium entspricht in ein neues WorkSheet kopiert werden.

Der zweite Schritt entspricht dem ersten, nur dass sich jetzt die Suchkriterien geändert haben. Wieder sollen die Ergebnisse in einem neuen Sheet aussgegeben werden.

Das ganze soll geschehen, wenn man in der Ursprungstabelle auf einen Button klickt.

Kann mir jemand dabei helfen?

Vielen Dank und viele Grüße

Mike

Answer 1

Hallo Mike,
dazu noch ein paar Fragen:
Kommen die gesuchten Informationen öfter vor?
Soll nur das Suchkriterium der Zelle oder die ganze Zeile übertragen werden?

Gruß
fedjo

Answer 2

Hallo Mike,

mit ein paar Änderungen sollte die Lösung aus diesem Beitrag Dir eventuell weiterhelfen.

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]

Answer 3

Hallo Oliver,

ja, das geht schon mal in die richtige Richtung.
Kann ich dem Skript denn auch beibringen, dass er nicht alle Spalten nach dem Suchbegriff absucht, sondern nur eine bestimmte?
Wenn ich das so laufen lasse, werden - weil die Suchwörte in mehrern Spalten vorhanden sind, aber nur eine relevant ist - zu viele Dublikate angelegt. Das macht dann eher mehr Arbeit ;-)

Kann ich es auch realisieren, dass als Suchwort eine bestimmte Kombination aus Wörtern (die aber in zwei unterschiedlichen Spalten stammen) genutzt wird?

Vielen Dank schon mal

Mike

Answer 4

Hallo Mike,

für die Bereichsangabe ändere in dem Makro die Zeile

With objAktSheet.Range("A1:IV65536")
Anstelle A1:IV65536 könnte dort auch, sollte es sich z.B. um Spalte B handeln "B1:B65536" stehen.

Für den Suchbegriff müsstest Du im Makro die Zeile

varSuchtext = InputBox("Bitte Scuchbegriff eintragen")
ändern. Die könnte z.B. für eine Kombination aus Zelle B1 und C1 so aussehen:

varSuchtext = Range("B1") & Range("C1")

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]

Answer 5

Hallo Oliver,

super... das mit der Begrenzung des Suchraumes habe ich verstanden.

Es treten aber noch mehr Fragen auf.

Zum einen muss ich die Zeile

If varSuchtext = "" Or varSuchtext = False Then Exit Sub

zwingend auskommentieren, weil sonst ein

Run-Time Error 13: Type mismatch

erzeugt wird. Ist die Zeile weg, geht alles normal.

Dann noch die Frage nach dem Suchkriterium:

varSuchtext = Range("B1") & Range("C1")

Wenn ich in die beiden Zellen B1 und C1 etwas schreibe, wonach gesucht werden soll, dann wird das ganze mit einem

Fehler 400

abgebrochen.
Leider keine weiteren Erklärungen!

Ich habe aber noch eine weitere Frage:
Da die Tabelle Zeile mit Erklärungen für die ganzen Spalten enthält, würde ich diese auch gern mitkopieren.
Kann ich das hiermit:

With objAktSheet.Range("A1:AX1")
Do
objAktSheet.Rows.Copy

Gruß und schon jetzt vielen vielen Dank für die Hilfe!

Answer 6

HAllo Mike,

sorry, war ein Fehler bei der Deklaration der Variablen. Ändere im Makro die Zeile

Dim varSuchtext As String
in

Dim varSuchtext As Variant
Zu dem Fehler400 kann ich nicht viel sagen, da ich Deine Datei nicht kenne. Kannst Du die eventuell z.B. mal bei http://www.fileuploadx.de/ hochladen und den Link, den Du erhälst hier mal posten, damit man sich das in Deiner Datei ansehen kann. Bei mir funktioniert das Makro ohne Probleme.

Die Frage bezüglich des Kopierens habe ich leider nicht verstanden. Was meinst Du mit

Erklärungen für die ganzen Spalten enthält

?

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]

Answer 7

Hallo Oliver

Die Frage bezüglich des Kopierens habe ich leider nicht verstanden. Was meinst Du mit


Zitat:
Erklärungen für die ganzen Spalten enthält

Ja, da lag der Fehler zwischen meinen Ohren...
Ich wollte damit sagen, dass es eine Zeile gibt, die den Kopf für die ganze Tabelle bildet. Diese soll mit kopiert werden.
Ich muss hierfür also einen Bereich definieren, welcher dann kopiert wird, oder?

Mike

Answer 8

Hallo Mike,

mal angenommen, die Daten, die Du noch zusätzlich kopieren möchtest stehen in Zeile 1 und sollen in dem neuen Tabellenblatt ebenfalls in Zeile erscheinen, dann müsstest Du die Zeilen
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
in

Do
objAktSheet.Rows(1).Copy _
objNewSheet.Cells(1, 1)
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
ändern.

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]

Answer 9

Supi, funktioniert.
Habe ganz eingenmächtig mal bestimmt, dass nicht nur die erste sondern die erste bis vierte Zeile kopiert werden

With objAktSheet.Range("A1:C1000")
Set rngSuchbereich = .Find(What:=varSuchtext, LookIn:=xlValues)
If Not rngSuchbereich Is Nothing Then
strAddresse = rngSuchbereich.Address
Do
objAktSheet.Rows.Range("A1:AY4").Copy _
objNewSheet.Cells(1, 1)
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

Dummerweise wird wieder mit diesem Fehler 400 abgebrochen.
Die ersten vier Zeilen sind aber kopiert....
Sehr suspekt!

Answer 10

Hallo Mike,

für den Fehler400 benötige ich, wie bereits in AW6 geschrieben die Datei.

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]