AW: daueraktivität ????
01.03.2003 14:13:39
dirk
ja aber ich möchte das, das fenster "suchen" immer da ist wenn ich auf mein
tabellblatt "suchen" gehe und zum bsp das makro bei enter startet!
damit wäre ja die daueraktivität unterbunden!
weiss du was ich meine!
gruss dirk
*schwitz* ich hoff ich habs jetzt besser erklärt!
danke für deine mühe
- geht das denn das man das fenster suchen in einem tabellenblatt immer sieht wenn der code in einem modul eingefügt ist!
hier ist der code kennst du bestimmt!
Hi Dirk
Sub Suchenkopieren_alleTabellen()
' mehrmals geändert Erich M.
' Deklaration Variablen
Dim wks As Worksheet
Dim rng As Range
Dim sAddress As String, sFind As String
Dim Cr As Long, tarWks As String
Dim mySpalte As String
Dim myName2 As String, Tb(1 To 15) As Worksheet, gefunden As Boolean
' Suchbegriff wird per Inputbox abgefragt
sFind = InputBox("Bitte Suchbegriff eingeben:")
' Blatt mit Name 'Doppelte' wird gesucht, falls nicht vorhanden neu angelegt.
For Each Tb(3) In ThisWorkbook.Worksheets
If Tb(3).Name = "Doppelte" Then gefunden = True: Exit For
Next
If Not gefunden Then
Worksheets.Add.Move After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "Doppelte"
End If
Set Tb(3) = ThisWorkbook.Worksheets("Doppelte")
With Tb(3)
.Cells.Clear
.Cells(1, 1) = "Der gesuchte Wert " & sFind & " wurde so oft in dieser Datei gefunden "
.Cells(2, 1) = "'"
End With
'myName2 = InputBox("Tabellenname")
tarWks = "Doppelte" ' Zieltabelle
Cr = 65536
If Worksheets(tarWks).Cells(Cr, 1) = "" Then
Cr = Worksheets(tarWks).Cells(Cr, 1).End(xlUp).Row
End If
If Cr = 2 Then Cr = 3
' Alle Zeilen in denen der Suchbegriff vorkommt werden ins Blatt 'Doppelte' kopiert
For Each wks In Worksheets
If wks.Name = tarWks Then GoTo Exitfor
' Sheets(myName2).Activate
Set rng = wks.Cells.Find(what:=sFind, _
LookAt:=xlWhole, LookIn:=xlFormulas)
If Not rng Is Nothing Then
sAddress = rng.Address
Do
Application.Goto rng, True
' If MsgBox("Weiter und kopieren", vbYesNo + vbQuestion) = vbNo Then Exit Sub
wks.Rows(rng.Row).Copy Destination:=Worksheets(tarWks).Rows(Cr)
Cr = Cr + 1
Set rng = Cells.FindNext(After:=ActiveCell)
If rng.Address = sAddress Then Exit Do
Loop
End If
Exitfor:
Next wks
' Suchvorgang beendet
' Seite wird eingerichtet (Layout)
'MsgBox prompt:="Keine neue Fundstelle!"
Sheets("Doppelte").Activate
Worksheets("Doppelte").Select
ActiveWindow.FreezePanes = False
Range("B3").Select
ActiveWindow.FreezePanes = True
Range("A1:I1").Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 3 'xlAutomatic
End With
Range("2:2").Select
Selection.RowHeight = 6
Range("G1").Select
' Worksheets("Doppelte").Select
' Range("B2").Select
' ActiveWindow.FreezePanes = True
' Range("G1").Select
End Sub