.Interior.ColorIndex проблема

Question

У меня есть саб, который копирует все ячейки с текстом в столбце и переносит их на отдельный лист. Изменяет цвет заливки каждой ячейки после ее транспонирования. Затем пользователь может добавить дополнительные данные и повторно запустить макрос, и он пропустит уже скопированные ячейки, сначала посмотрев на цвет заливки.

Все работает, как и ожидалось, с одним исключением. Только скопированные ячейки становятся желтыми после запуска макроса (ожидаемый результат), но каждая последующая ячейка будет менять цвет всякий раз, когда в нее вводятся какие-либо данные (неожиданный результат.) Я попытался добавить строку, чтобы изменить цвет следующей пустой ячейки обратно на 0, но это не помогло.

Есть ли в любом случае, чтобы Excel не переформатировал цвет ячеек после запуска этого макроса?

Вот полный Sub

Sub TransposeSubLocation()
Dim sh As Worksheet
Dim sht As Worksheet
Dim lRow As Long
Dim lCol As Long
Dim lYellow As Range
Set sh = Worksheets("Sub Location Lists")
Set sht = Worksheets("Equipment List")
Application.FindFormat.Interior.ColorIndex = 6

For i = 1 To 1000 Step 1
    If sh.Cells(5, i).Value <> "" Then
        lRow = sh.Cells(sh.Rows.Count, i).End(xlUp).Row
        lCol = sht.Cells(5, sht.Columns.Count).End(xlToLeft).Column
        On Error Resume Next
            Set lYellow = sh.Range(sh.Cells(6, i), sh.Cells(lRow, i)).Find(what:="*", after:=sh.Cells(6, i), SearchDirection:=xlPrevious, SearchFormat:=True).Offset(1, 0)

        If lCol > 1 Then
            lCol = lCol + 1
        End If

        If sh.Cells(6, i).Interior.ColorIndex = 6 Then
            sh.Range(lYellow, sh.Cells(lRow, i)).Copy
            sht.Cells(5, lCol).PasteSpecial Transpose:=True
            sh.Range(sh.Cells(6, i), sh.Cells(lRow, i)).Interior.ColorIndex = 6
            'Here I attempted to force it back to no fill but this did not help
            sh.Cells(lRow, i).Offset(1, 0).Interior.ColorIndex = 0

            Else: sh.Range(sh.Cells(6, i), sh.Cells(lRow, i)).Copy
            sht.Cells(5, lCol).PasteSpecial Transpose:=True
            sh.Range(sh.Cells(6, i), sh.Cells(lRow, i)).Interior.ColorIndex = 6
            sh.Cells(lRow, i).Offset(1, 0).Interior.ColorIndex = 0
        End If
    End If
Next
    End Sub