suchen, Arbeitsblätter auslassen

Private Sub Suche(strSuchtext As String)
Dim SuchKatalogblattName As String
Dim objBlatt As Worksheet
Dim objSuchKatalogblatt As Worksheet
Dim objZelle As Range
Dim objZeile As Range
Dim strErsteFundstelle As String
Dim intButton As Integer
Dim objForm As UserForm
Dim strSuchtext2 As String
'wir kommen hier von der Public Sub Suchen() aus hin
'Prüfen, ob SuchKatalogblatt bereits existiert
Set objSuchKatalogblatt = GetWorksheet(strSuchtext)
'Wenn SuchKatalogblatt nicht existiert, dann...
'If 1
If objSuchKatalogblatt Is Nothing Then
'Alle Blätter durchlaufen
For Each objBlatt In ActiveWorkbook.Worksheets
'Verwendeten Bereich jedes Blatts durchsuchen
With objBlatt.UsedRange
'Suchfunktion aufrufen
Set objZelle = .Find(What:=strSuchtext, LookIn:=xlValues)
'Wenn erster Treffer, dann...
'If 2
If Not objZelle Is Nothing Then
'... Fundstelle merken
strErsteFundstelle = objBlatt.Name & "!" & objZelle.Address
'Neues Katalogblatt anlegen
Set objSuchKatalogblatt = Worksheets.Add(After:=Worksheets(Worksheets.Count))
'Suchtext bildet Namen des SuchKatalogblattes
objSuchKatalogblatt.Name = strSuchtext
'***SuchKatalogblatt gestalten***
'SuchKatalogblatt gestalten
With objSuchKatalogblatt
'Spaltenformatierungen festlegen
.Columns(1).ColumnWidth = 10
.Columns(2).ColumnWidth = 26
.Columns(3).ColumnWidth = 24
.Columns(4).ColumnWidth = 7
.Columns(5).ColumnWidth = 24
.Columns(6).ColumnWidth = 26
.Columns("A").NumberFormat = "0000"
.Columns("B").NumberFormat = "0000"
.Columns("C").NumberFormat = "00"
'Zeileninhalte und -formatierungen festlegen
'Alle Zellinhalte links ausrichten
.Rows.HorizontalAlignment = xlLeft
With .Rows(1)
.Cells(1).Value = "CD-Nummer:"
.Cells(1).Font.Size = 8
.Cells(1).Font.Bold = True
End With
With .Rows(1)
.Cells(2).Value = "CD-Seite:"
.Cells(2).Font.Size = 8
.Cells(2).Font.Bold = True
End With
With .Rows(1)
.Cells(3).Value = "Künstler:"
.Cells(3).Font.Size = 8
.Cells(3).Font.Bold = True
End With
With .Rows(1)
.Cells(4).Value = "Album:"
.Cells(4).Font.Size = 8
.Cells(4).Font.Bold = True
End With
End With
Do
'Blatt mit Fundstelle aktivieren
objBlatt.Activate
'Fundstelle markieren
objZelle.Select
'Anwender fragen, ob Suche fortgesetzt werden soll
intButton = MsgBox("Weiter suchen?", vbQuestion + vbYesNo, APP_NAME)
'Wenn Antwort nicht 'Ja' lautet, dann...
'If 010
If intButton <> vbYes Then
'Fragen, ob das Suchkatalogblatt geöffnet werden soll
intButton = MsgBox("Das Suchkatalogblatt öffnen?22", vbQuestion + vbYesNo, APP_NAME)
'Wenn die Antwort nicht 'Ja' lautet, dann...
'If 016
If intButton <> vbYes Then
'Infofenster mit "Suche beendet!" öffnen und...
MsgBox "Suche beendet3!", vbInformation, APP_NAME
'...Makro beenden
Exit Sub
'If 016
Else
'Suchkatalogblatt aktivieren
objSuchKatalogblatt.Activate
'Makro beenden
Exit Sub
'If 010
End If
'If 016
End If
'Nach nächstem Vorkommen suchen
Set objZelle = .FindNext(objZelle)
'Schleife wiederholen solange weitere Fundstellen auftauchen und erste Fundstelle noch nicht erreicht
Loop While Not objZelle Is Nothing And objBlatt.Name & "!" & objZelle.Address <> strErsteFundstelle
'If 2
End If
End With
Next
MsgBox "Keine weiteren Fundstellen.", vbInformation, APP_NAME
'Fragen, ob das Suchkatalogblatt geöffnet werden soll
intButton = MsgBox("Das Suchkatalogblatt öffnen?33", vbQuestion + vbYesNo, APP_NAME)
'Wenn die Antwort nicht 'Ja' lautet, dann...
'If 015
If intButton <> vbYes Then
'Infofenster mit "Suche beendet!" öffnen und...
MsgBox "Suche beendet3!", vbInformation, APP_NAME
'...Makro beenden
Exit Sub
'If 015
Else
'Suchkatalogblatt aktivieren
objSuchKatalogblatt.Activate
Exit Sub
'If 015
End If
'If 001
End If
End Sub