Hallo,
ich habe folgendes Problem: im u.g. Code werden zwei Blätter miteinander verglichen und die doppelten Ergebnisse werden beide in einem dritten Blatt ausgegeben. Nun hätte ich gern zusätzlich die doppelten Zeilen im ersten und zweiten Blatt rot eingefärbt - was beim ersten auch klappt, beim zweiten mit derselben Methode aber nicht. Wer kann mir helfen, wie geht das?
Ganz vielen Dank im voraus & mit Grüßen an alle Forumsteilnehmer/innen,
asz
'Startwerte setzen
SpalteQ = 2 'Spalte, die auf Duplikate geprüft werden soll, wenn auf Titel geprüft werden soll, muss hier die 1 stehen
ZeileZ = 2 '1. Zeile in die Duplikate übertragen werden sollen
With wksQuelle2
Set BereichQ2 = .Range(.Cells(2, SpalteQ), .Cells(.Rows.Count, SpalteQ).End(xlUp))
End With
With wksQuelle1
' Duplikate suchen
For ZeileQ1 = 2 To .Cells(.Rows.Count, SpalteQ).End(xlUp).Row
Set ZelleQ2 = BereichQ2.Find(what:=.Cells(ZeileQ1, SpalteQ).Value, LookIn:=xlValues, _
lookat:=xlWhole, MatchCase:=False)
If Not ZelleQ2 Is Nothing Then
'Datensatz aus Quelle1 übertragen
.Rows(ZeileQ1).Copy Destination:=wksZiel.Rows(ZeileZ)
.Rows(ZeileQ1).Select
Selection.Interior.Color = RGB(500, 0, 0)
wksZiel.Cells(ZeileZ, "J").Value = wbQuelle1.Name & " " & wksQuelle1.Name
wksZiel.Cells(ZeileZ, "K").Value = ZeileQ1
ZeileZ = ZeileZ + 1
Adresse1 = ZelleQ2.Address
'Duplikate aus Quelle2 übertragen
Do
ZelleQ2.EntireRow.Copy Destination:=wksZiel.Rows(ZeileZ)
wksZiel.Cells(ZeileZ, "J").Value = wbQuelle2.Name & " " & wksQuelle2.Name
wksZiel.Cells(ZeileZ, "K").Value = ZelleQ2.Row
ZeileZ = ZeileZ + 1
Set ZelleQ2 = BereichQ2.FindNext(After:=ZelleQ2)
Loop Until ZelleQ2 Is Nothing Or ZelleQ2.Address = Adresse1
End If
Next
End With
wksZiel.Columns("J:K").AutoFit