Strings vergleichen in 2 verschiedenen Tabellen

Sub Vergleichen()
Dim iRowA As Integer, iCounter As Integer, iFirst As Integer, iSecond As Integer
Dim iRowB As Integer
Dim sTxtA As String, sTxtB As String
Dim bln As Boolean
iRowA = 1
iFirst = 1
iSecond = 2
For iCounter = 1 To 2
Do Until IsEmpty(Cells(iRowA, iFirst))
bln = False
iRowB = 1
sTxtA = Cells(iRowA, iFirst).Value
Do Until IsEmpty(Cells(iRowB, iSecond))
sTxtB = Cells(iRowB, iSecond).Value
If Mid(sTxtA, 1, 8) = Mid(sTxtB, 1, 8) Then
bln = True
Cells(iRowA, iFirst).Interior.ColorIndex = 5
End If
iRowB = iRowB + 1
Loop
If bln = False Then Cells(iRowA, iFirst).Interior.ColorIndex = 6
iRowA = iRowA + 1
Loop
iFirst = 2
iSecond = 1
iRowA = 1
Next iCounter
Dim rngzelle        As Range
Dim lngZeile        As Long
lngZeile = 36
With Worksheets("Woche")   'Hier Name des Zielblattes anpassn
For Each rngzelle In ActiveSheet.Range("A1:H100")   'Suchbereich anpassen
If rngzelle.Interior.ColorIndex = 6 Then
.Cells(lngZeile, 5).Value = rngzelle.Value
lngZeile = lngZeile + 1
End If
Next rngzelle
.Range("C36:C100").Sort Key1:=.Range("C36"), _
Order1:=xlAscending, _
Header:=xlNo
End With
End Sub