Bei Suche Groß/Kleinschreibung egal
Wolfgang
den nachfolgenden Code erhielt ich hier aus dem Forum. Er läuft auch soweit sehr gut. Der Querverweis auf Schaltfläche 1 bewirkt dabei lediglich einen Refresh und ist, so glaube ich, für meine Frage nicht erheblich. Ich würde nämlich gerne erreichen, dass die Schreibweise des Suchbegriffs in Groß oder Kleinschreibung nicht erheblich ist. Wie kann ich den folgenden Code entsprechend anpassen? Danke schon jetzt für die Rückmeldungen.
Gruß - Wolfgang
Option Explicit
Sub SuchenKopieren()
Static Suchbegriff As String
Dim Zelle As Variant, ErsteAdresse As String
Dim letzteZeile As Integer
Dim wksQuelle As Worksheet
Dim wksZiel As Worksheet
Dim rng As Range
Set wksQuelle = Worksheets("Maßnahmen")
Set wksZiel = Worksheets("Einstellungen")
Application.ScreenUpdating = False
'bewirkt Refresh
Sheets("Einstellungen").CommandButton1 = True
'Suche beginnen
Suchbegriff = InputBox(Prompt:="Bitte Suchbegriff eingeben." & vbLf & _
"Bitte Groß und Kleinschreibung beachten!", Default:=Suchbegriff)
If Suchbegriff = "" Then
MsgBox "Es wurde kein Suchbegriff eingegeben.", vbCritical
Exit Sub
End If
With wksQuelle
'Überschriftenzeile kopieren ...
.Range("A1:K1").Copy Destination:=wksZiel.Range("A14")
'Suche in Spalte F
Set Zelle = .Columns(6).Find(What:="*" & Suchbegriff & "*", After:=.Range("F1"), _
LookIn:=xlValues, lookat:=xlWhole, _
SearchOrder:=xlNext, MatchCase:=True)
If Not Zelle Is Nothing Then
ErsteAdresse = Zelle.Address
letzteZeile = 15
Do
'gefundenen Zeile Spalten A bis K kopieren in nächste Zeile im Zielblatt
.Range(.Cells(Zelle.Row, 1), .Cells(Zelle.Row, 11)).Copy _
Destination:=wksZiel.Cells(letzteZeile, 1)
'Suche wiederholen
Set Zelle = .Columns(6).FindNext(Zelle)
letzteZeile = letzteZeile + 1
Loop While Not Zelle Is Nothing And Zelle.Address ErsteAdresse
End If
End With
For Each rng In Range("A14").CurrentRegion.Rows
If rng.Row Mod 2 = 0 Then rng.Interior.ColorIndex = 15
Next
wksZiel.Select
Range("G4").Select
Application.ScreenUpdating = True
End Sub
Anzeige