01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47 |
|
Option Explicit
Sub Suchen()
' Nur über Schaltfläche aufrufen!!!
Dim oFinde As Object
Dim sSuch As String, sErsteAdresse As String, iOutZeile As Long
Dim WShZ As Worksheet, WShQ As Worksheet
Const csSpalten As String = "B1,F1,G1" ' Spalten angeben
' Quell- und Zielblatt setzen
Set WShQ = Worksheets("Tabelle1") ' <<<anpassen>>>
Set WShZ = Worksheets("Tabelle2") ' <<<anpassen>>>
sSuch = WShQ.Buttons(Application.Caller).Caption ' Text aus aufrufendem Button
If sSuch = "" Then Exit Sub
' Erstes Feld mit dem Suchbegriff suchen
Set oFinde = WShQ.Range("B:B").Find(sSuch, LookIn:=xlValues, LookAt:=xlWhole)
If Not oFinde Is Nothing Then
sErsteAdresse = oFinde.Address ' Erste Adresse merken
Do
iOutZeile = iOutZeile + 1 ' Nächste Ausgabezeile
WShQ.Range(Replace(csSpalten, "1", oFinde.Row)).Copy _
WShZ.Cells(iOutZeile, "B") ' Zeile kopieren
With WShZ.Cells(iOutZeile, "C")
.Value = Replace(.Value, "Oktoberfest", "OF") ' Text umwandeln
End With
Set oFinde = WShQ.Range("B:B").FindNext(oFinde) ' Nächsten Suchbegriff suchen
If oFinde Is Nothing Then Exit Do
Loop While Not oFinde Is Nothing And oFinde.Address <> sErsteAdresse
End If
Call SetButtons(False) ' Buttons ausblenden
End Sub
Sub SetButtons(Optional bWie As Boolean = True)
' Buttons (un)sichtbar schalten
With Worksheets("Tabelle1")
.Buttons("Schaltfläche 1").Visible = bWie
.Buttons("Schaltfläche 2").Visible = bWie
End With
End Sub
Sub Buttons_Ein()
Call SetButtons
End Sub
|