Изменившиеся ячейки

Sub mymacros()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    ActiveSheet.DisplayPageBreaks = False
    Application.DisplayStatusBar = False
    Application.DisplayAlerts = False
    
oldRow = Sheets(2).UsedRange.Row + Sheets(2).UsedRange.Rows.Count - 1 /Последняя заполненная ячейка на старом листе
newRow = Sheets(1).UsedRange.Row + Sheets(1).UsedRange.Rows.Count - 1 /Последняя заполненная ячейка на новом листе
For i = 1 To newRow
    curval = Sheets(1).Cells(i, 1) /берём данные id с нового листа
    For j = 1 To oldRow /прогоняем по старому листу
        If Sheets(2).Cells(j, 1) = curval Then /и ищем совпадения
            If Sheets(2).Cells(j, 2) <> Sheets(1).Cells(i, 2) Then /если id найден, и второй столбец у нового и старого различаются, то
                Sheets(3).Cells(i, 1) = Sheets(1).Cells(i, 1) /записываем изменения на третий лист
                Sheets(3).Cells(i, 2) = Sheets(1).Cells(i, 2) /записываем изменения на третий лист
                Exit For /выходим из цикла
            End If
        Exit For
        End If
    Next j
Next i
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    ActiveSheet.DisplayPageBreaks = True
    Application.DisplayStatusBar = True
    Application.DisplayAlerts = True
End Sub

Sub New_and_Change()
  Dim Mas(), i&, Dic As Object, iCount&
    Mas = Sheets(2).UsedRange.Value
    Set Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1
    For i = 1 To UBound(Mas)
        Dic(Mas(i, 1)) = Mas(i, 2)
    Next
    Mas = Sheets(1).UsedRange.Value
    On Error Resume Next
    For i = 1 To UBound(Mas)
        If Dic(Mas(i, 1)) <> Mas(i, 2) Then
            iCount = iCount + 1
            Mas(iCount, 1) = Mas(i, 1): Mas(iCount, 2) = Mas(i, 2)
        End If
    Next
    If iCount Then
        Sheets(3).Cells(1, 1).Resize(iCount, 2).Value = Mas
    Else
        MsgBox "Новых или изменившихся значений не найдено"
    End If
End Sub