Code anpassen
15.07.2016 10:55:48
Andreas
Ich habe hier ein Makro von Ramses gefunden was für mein Anliegen auch gut funktionieren würde.
Mein 1.Problem dabei ist es das ich bei der Anweisung im Code weiter unten
If MsgBox("Suchbegriff: " & sFind & ",gefunden in " & wks.Name & ", " & rng.Address, vbYesNo + vbQuestion, "Weitersuchen ?") = vbNo Then Exit Sub
auf ja klicke wird der Datensatz der gefunden wurde wird dann auch richtig in die tabelle3 kopiert.
-->Ich möchte gern dieses Meldungsfenster nicht mehr anzeigen lassen und bei jeden Datensatz der gefunden wurde auf ja klicken müssen, sondern die Anweisung gleich
wks.Rows(rng.Row).Copy Destination:=Worksheets(tarWks).Rows(cr)
ausführen lassen wollen.
Wenn ich aber die MsgBox deaktiviere und dafür die Anweisung
'If ActiveCell = sFind Then
meckert mir der Code im Einzelschrittmodus bei der Anweisung Loop
Kann mir jemand von Euch den Code dementsprechend anpassen? Ich bekomme das selber einfach nicht auf die Reihe .
Zum zweiten Problem in diesem Makro möchte ich gern erreichen das das Makro nicht alle Tabellenblätter durchsucht sondern nur das Tabellenblatt1. (Also das Makro so abändern, das es nur für das Tabellenblatt Tabelle1 läuft
Nur zur Info warum ich das so haben möchte:
Ich habe im Tabellenblatt Tabelle1 ab Spalte C10 fortlaufend meine Kontoauszugsdaten seit dem Jahr 2005 dort stehen.
Ich möchte einfach in Tabelle1 in A1 einen Suchbegriff eingeben zB: DEVK dann soll das Makro mir alle Datensätze mit der Zeichenfolge an irgendeiner Stelle im Zelltext suchen und diesen Datensatz dann in die Tabell3 schreiben.
'Dieses Makro schreibt den Datensatz aus Suchbegriff in Tabelle1 A1 in die Zieltabelle Tabelle3
Sub Var_MultiSeek()
'by Ramses
'Sucht in der gesamten Mappe nach einem Begriff und kopiert die
'gefundene Zeile in eine zu definfierende Ergebnistabelle
Dim wks As Worksheet
Dim rng As Range
Dim sAddress As String
'Suchbegriff
Dim sFind As Variant
Dim cr As Long, tarWks As String
'Name_der_Zieltabelle
'Bitte Anpassen !!!!
tarWks = "Tabelle3"
cr = 65536
If Worksheets(tarWks).Cells(cr, 3) = "" Then
cr = Worksheets(tarWks).Cells(cr, 3).End(xlUp).Row
End If
If cr = 0 Then cr = 1
'Suchbegriff definieren
'sFind = InputBox("Bitte Suchbegriff eingeben:")
'If sFind = "" Then Exit Sub
'Suchbegriff auf Zelle definieren
sFind = Worksheets("Tabelle1").Range("A1")
For Each wks In Worksheets
If wks.Name = tarWks Then Exit Sub
Set rng = wks.Cells.Find(What:=sFind, _
LookAt:=xlPart, LookIn:=xlFormulas)
If Not rng Is Nothing Then
sAddress = rng.Address
Do
Application.Goto rng, True
'Für die Automation kann die "If"-Anweisung auskommentiert werden
If MsgBox("Suchbegriff: " & sFind & ",gefunden in " & wks.Name & ", " & rng.Address, _
vbYesNo + vbQuestion, "Weitersuchen ?") = vbNo Then Exit Sub
'If ActiveCell = sFind Then "hier meckert mir der Code wenn ich mit F8 im _
Einzelschritt das Makro durchlaufe bei der Anweisung Loop
wks.Rows(rng.Row).Copy Destination:=Worksheets(tarWks).Rows(cr)
cr = cr + 1
Set rng = wks.Cells.FindNext(After:=ActiveCell)
If rng.Address = sAddress Then Exit Do
Loop
End If
NextStart:
Next wks
MsgBox prompt:="Keine neue Fundstelle!"
End Sub