Abgleich Nur bis zu einer Bestimmten Spalte

Private Sub CommandButton1_Click()
Dim TB1, TB2, TB3, i As Double, j As Integer, LR1 As Double, LC1 As Integer
Dim Zeile As Double, Spalte As Integer
Const Rot = -167769619
Const Schwarz = -1677696190
Const strLeer = "(Leer)"
Set TB1 = Sheets("Liste")
Set TB2 = Sheets("Basis_Ausstattung_A")
Set TB3 = Sheets("Sonder_Ausstattung_B")
With TB1
LR1 = .Cells(.Rows.Count, "B").End(xlUp).Row 'letzte Zeile der Spalte
LC1 = .Cells.SpecialCells(xlCellTypeLastCell).Column   'Letzte Spalte des gesamten  _
Blattes
With .Range(.Cells(2, 6), .Cells(LR1, LC1))
.Font.Color = Gruen
.FormulaR1C1 = "=IFERROR(VLOOKUP(RC2," & TB2.Name & "!C2:C36,COLUMN(RC[-3]),0),"""") _
_
" 'Sverweis auf TB2
.Value = .Value 'Formel in Werte tauschen
End With
For j = 6 To LC1
For i = 2 To LR1
If .Cells(i, j)  strLeer And .Cells(i, j)  "" Then
If WorksheetFunction.CountIf(TB3.Columns(1), .Cells(i, 1)) > 0 Then  ' ist   _
_
Nr überhaupt da
Zeile = WorksheetFunction.Match(.Cells(i, 1), TB3.Columns(1), 0) ' in   _
_
welcher Zeile
If WorksheetFunction.CountIf(TB3.Rows(Zeile), Left(.Cells(i, j), 2) & "* _
_
") > 0 Then   ' ist links2 in Zeile
Spalte = WorksheetFunction.Match(Left(.Cells(i, j), 2) & "*", TB3.  _
_
Rows(Zeile), 0) ' in welcher Spalte
With .Cells(i, j)
.Value = TB3.Cells(Zeile, Spalte) 'Wert tauschen
.Font.Color = Rot ' färben
End With
End If
End If
Else
.Cells(i, j).Font.ColorIndex = xlAutomatic
End If
Next i
Next j
End With
End Sub