Бесконечная работа макроса при объемах больше 100 000 строк

Sub Compare3Files()
Dim myName As String, wB As Workbook
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Выберите ПЕРВЫЙ файл для сравнения"
.Show
If .SelectedItems.Count = 0 Then Exit Sub
myName = .SelectedItems(1)
End With
Application.ScreenUpdating = False
Workbooks.Open Filename:=myName: Set wB = Workbooks(ActiveWorkbook.Name)
 
Dim myName1 As String, wB1 As Workbook
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Выберите ВТОРОЙ файл для сравнения"
.Show
If .SelectedItems.Count = 0 Then Exit Sub
myName1 = .SelectedItems(1)
End With
Application.ScreenUpdating = False
Workbooks.Open Filename:=myName1: Set wB1 = Workbooks(ActiveWorkbook.Name)
 
Dim myName2 As String, wB2 As Workbook
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Выберите ТРЕТИЙ файл для сравнения"
.Show
If .SelectedItems.Count = 0 Then Exit Sub
myName1 = .SelectedItems(1)
End With
Application.ScreenUpdating = False
Workbooks.Open Filename:=myName1: Set wB2 = Workbooks(ActiveWorkbook.Name)
 
Dim SaveFile As String, sB As Workbook
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Выберите файл для сохранения"
.Show
If .SelectedItems.Count = 0 Then Exit Sub
SaveFile = .SelectedItems(1)
End With
Application.ScreenUpdating = False
Workbooks.Open Filename:=SaveFile: Set sB = Workbooks(ActiveWorkbook.Name)
 
Dim i As Long, j As Long, k As Long, Flag As Boolean
 
i = 1: k = 1
Do While wB.Worksheets(1).Cells(i, 1) <> ""
' Проверяем в 1 файле на 1 листе строки 1-го столбца, от 1 до пустой, то есть до конца таблицы.
   j = 1: n = 1: Flag1 = False: Flag2 = False ' Flag - это признак, что запись из Файла1 есть или нет в Файле2.
   
   Do While wB1.Worksheets(1).Cells(j, 1) <> ""
   ' Проверяем во 2 файле на 1 листе строки 1-го столбца, от 1 до пустой, то есть до конца таблицы.
       If wB.Worksheets(1).Cells(i, 1) = wB1.Worksheets(1).Cells(j, 1) Then Flag1 = True
       ' Нашли запись из Файла1 в Файле2, устанавливаем Flag в True
       j = j + 1
   Loop
   Do While wB2.Worksheets(1).Cells(n, 1) <> ""
   ' Проверяем во 2 файле на 1 листе строки 1-го столбца, от 1 до пустой, то есть до конца таблицы.
       If wB.Worksheets(1).Cells(i, 1) = wB2.Worksheets(1).Cells(n, 1) Then Flag2 = True
       ' Нашли запись из Файла1 в Файле3, устанавливаем Flag в True
       n = n + 1
   Loop
   
   If Flag1 = False And Flag2 = False Then ' Если запись из Файла1 не встретилась в файле1 и файле2, то
       sB.Worksheets(1).Range(Cells(k, 1), Cells(k, 10)).Value = wB.Worksheets(1).Range(Cells(i, 1), Cells(i, 10)).Value
       ' Записываем ее в Файл3
       k = k + 1 ' Переходим на следующую строчку в Файле3
   End If
  i = i + 1
Loop
MsgBox "Выполнение сравнения законченно успешно"
End Sub