wie müßte ich den folgenden Code ergänzen, damit ich das Ergebnis der Suche im jeweiligen Wechsel in jeder zweiten Zeile farblich abgesetzt bekomme (weiß und irgendeine helle Farbe)? - Danke schon jetzt für die Rückmeldungen.
Herzliche Grüße
Wolfgang
Sub SuchenKopieren()
Sheets("Einstellungen").CommandButton1 = True
'Call BlattschutzRaus
Static Suchbegriff As String
Dim Zelle As Variant, ErsteAdresse As String
Dim LetzteZeile As Integer
Dim wksQuelle As Worksheet
Dim wksZiel As Worksheet
Set wksQuelle = Worksheets("Basis")
Set wksZiel = Worksheets("Ergebnis")
Application.ScreenUpdating = False
wksZiel.Range("A14:K1000").Cells.Clear 'Alte Tabelleninhalte löschen
Suchbegriff = InputBox(Prompt:="Bitte Suchbegriff eingeben:", _
Default:=Suchbegriff)
If Suchbegriff = "" Then
MsgBox "Bitte Suchbegriff eingeben", 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
wksZiel.Select
Range("A1").Select
Application.ScreenUpdating = True
End Sub