Есть ли способ ускорить этот макрос VBA, который использует диапазоны из двух разных книг?

Question

Я надеюсь, что кто-то может помочь мне здесь, я работаю с файлом, который имеет около 38000 строк и 180 столбцов. Я использую макрос для обновления полей в одной книге со значениями в другой книге, но для запуска требуется около 2 минут. Я ищу способ сократить это время, я перепробовал все, что смог найти в предыдущих вопросах, но он все еще слишком длинный.

Как видно из кода ниже, макрос проверяет, чтобы увидетьКоличество строк в каждой книге одинаковое (обратите внимание, что в одной из них есть еще 1 строка, следовательно, в последнем временном файле с +1), а затем я хочу проверить, является ли поле во временном файле определенного цвета, если нет, то измените его, еслии т. д. Я использую этот цвет для отслеживания значений, которые изменились из необработанного файла, так как я не хочу, чтобы эти значения снова были перезаписаны после того, как они были изменены один раз. Я использую диапазоны, чтобы мне не нужно было обращаться к рабочим листам все время, так как это увеличивает время выполнения. Любая помощь будет оценена.

Sub SavetoTemp()

    StartTime = Timer
    Set wb = ThisWorkbook
    Set DT = wb.Worksheets("Data Table")

     With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .DisplayStatusBar = False
        .EnableEvents = False
        .ActiveSheet.DisplayPageBreaks = False
        DT.DisplayPageBreaks = False
    End With

    Dim TempFile As Workbook
    Dim TempSheet As Worksheet
    Dim LastCol As Long
    Dim colLetEnd As String

    If wb.Worksheets("Steering Wheel").Range("M30").Value = "" Then
        MsgBox "Please Select a Temporary File First"
        Exit Sub
    Else
        Set TempFile = Workbooks.Open(Range("M30").Value)
        Set TempSheet = TempFile.Worksheets(1)

        Dim LastRowDT As Long
        LastRowDT = DT.Cells(Rows.Count, "A").End(xlUp).row
        LastCol = DT.Cells(1, Columns.Count).End(xlToLeft).Column

        Dim LastRowTemp As Long
        LastRowTemp = TempSheet.Cells(Rows.Count, "A").End(xlUp).row + 1

        Dim tempCell As Range
        Dim r As Long
        Dim c As Long
        Dim rngDT As String
        Dim rngTemp As Range
        colLetEnd = Split(Cells(1, LastCol).Address, "$")(1)
        Set rngTemp = TempSheet.UsedRange
        rngDT = "A" & 3 & ":" & colLetEnd & LastRowDT

        If (LastRowTemp = LastRowDT) Then
            For Each cell In DT.Range(rngDT)
                Set tempCell = rngTemp.Cells(cell.row - 1, cell.Column)
                If Not tempCell.Interior.Color = RGB(188, 146, 49) Then
                    If IsNumeric(cell) And Not IsEmpty(cell) Then
                        If (Not cell = tempCell) Or (IsEmpty(tempCell)) Then
                            tempCell.Interior.Color = RGB(188, 146, 49)
                            tempCell = cell
                        End If
                    Else
                        If Not (StrComp(cell, tempCell, vbTextCompare) = 0) Then
                            tempCell.Interior.Color = RGB(188, 146, 49)
                            tempCell = cell
                        End If
                        End If
                    End If
            Next cell


            TempSheet.Cells.EntireColumn.AutoFit
            TempFile.Save
            TempFile.Close

            MsgBox "All Records Saved to Temp File Successfully!"
            wb.Worksheets("Steering Wheel").Activate
            MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")
            wb.Worksheets("Steering Wheel").Range("E48").Value = MinutesElapsed
            With Application
                .Calculation = xlCalculationAutomatic
                .ScreenUpdating = True
                .DisplayStatusBar = True
                .EnableEvents = True
            End With
            Else
            MsgBox "Please load the raw data file into your temp file before saving to it."
            With Application
                .Calculation = xlCalculationAutomatic
                .ScreenUpdating = True
                .DisplayStatusBar = True
                .EnableEvents = True
            End With
            Exit Sub
        End If
    End If
End Sub

Любое улучшение кода для сокращения времени выполнения является моей конечной целью.