В общем дело обстоит так. Макрос без сортировки работает изумительно. Как только делаешь с файлом сортировку всё работать перестаёт. И не важно сортировалось этим же макросом или удалил от туда эту часть и отсортировал потом в ручную - эффект тот же. При этом сортировка выполняется обсолютно правильно, т.е. сортируются строчки, а не отдельно взятые столбцы.

Ни какие танцы с бубмном не смогли заставить работать макрос после сорта, но в данном случае сортировка просто необходима. Может её можно выполнить при помощи какого-то кода, а не стандартными средствами Офиса? У кого есть мысли делитесь не стесняйтесь, буду благодарен за любые высказывания в тему...

Текст макроса:

Function FindID(ByRef Arr, ID)
FindID = 0
For i = 2 To UBound(Arr)
If Arr(i) = ID Then
FindID = i
Exit For
End If
Next i
End Function
Sub Main()
ActiveSheet.Range("$A$1:$O$10934").AutoFilter Field:=5, Criteria1:="="
Rows("2:11062").Select
Selection.Delete Shift:=xlUp
ActiveSheet.Range("$A$1:$O$9196").AutoFilter Field:=5
Range("A1").Select

Dim Arr1()
Dim Arr2()

Dim nRow1 'кол-во строк в первом листе
Dim nRow2
nRow1 = Worksheets(2).Columns(1).End(xlDown).Row
nRow2 = Worksheets(3).Columns(1).End(xlDown).Row

ReDim Arr1(2 To nRow1) 'массив л/с первого листа
ReDim Arr2(2 To nRow2)
For i = 2 To nRow1
Arr1(i) = Worksheets(2).Cells(i, 5).Text 'Cells(i, 4- столбец
Next i
For i = 2 To nRow2
Arr2(i) = Worksheets(3).Cells(i, 4).Text
Next i

par1 = 0 'счетчик замен
par2 = 0 'счетчик удалений/закрашиваний
par3 = 0 'счетчик добавленных строк

Dim currFind 'номер строки в которой найден нужный л/с
For i = nRow1 To 2 Step -1
currFind = FindID(Arr2, Arr1(i))
If currFind > 0 Then 'нашли строку с нов. знач.
Worksheets(2).Cells(i, 10).Value = Worksheets(3).Cells(currFind, 9).Value '9 - номер столбца в новом файле, Worksheets- номера листов
Worksheets(2).Cells(i, 11).Value = Worksheets(3).Cells(currFind, 10).Value
par1 = par1 + 1
Else 'не нашли
'Row(i).Delete 'удаляем строку
Worksheets(2).Range("A" & i & ":I" & i).Interior.ColorIndex = 46 'закрашиваем
par2 = par2 + 1
End If
Next i

Dim currMaxRow1 'последняя строка с учетом добавлений
currMaxRow1 = nRow1

For i = 2 To nRow2
currFind = FindID(Arr1, Arr2(i))
If currFind = 0 Then 'не нашли строку
currMaxRow1 = currMaxRow1 + 1
Worksheets(2).Cells(currMaxRow1, 2).Value = Worksheets(3).Cells(i, 1).Value
Worksheets(2).Cells(currMaxRow1, 3).Value = Worksheets(3).Cells(i, 2).Value
Worksheets(2).Cells(currMaxRow1, 4).Value = Worksheets(3).Cells(i, 3).Value
Worksheets(2).Cells(currMaxRow1, 5).Value = Worksheets(3).Cells(i, 4).Value
Worksheets(2).Cells(currMaxRow1, 6).Value = Worksheets(3).Cells(i, 5).Value
Worksheets(2).Cells(currMaxRow1, 7).Value = Worksheets(3).Cells(i, 6).Value
Worksheets(2).Cells(currMaxRow1, 8).Value = Worksheets(3).Cells(i, 7).Value
Worksheets(2).Cells(currMaxRow1, 9).Value = Worksheets(3).Cells(i, 8).Value
Worksheets(2).Cells(currMaxRow1, 10).Value = Worksheets(3).Cells(i, 9).Value
Worksheets(2).Cells(currMaxRow1, 11).Value = Worksheets(3).Cells(i, 10).Value


Worksheets(2).Range("A" & currMaxRow1 & ":I" & currMaxRow1).Interior.ColorIndex = 10 'закрашиваем

par3 = par3 + 1
End If
Next i

Columns("A:O").Select
ActiveWorkbook.Worksheets("Все должники").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Все должники").Sort.SortFields.Add Key:=Range( _
"B2:B11335"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Все должники").Sort.SortFields.Add Key:=Range( _
"C2:C11335"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
ActiveWorkbook.Worksheets("Все должники").Sort.SortFields.Add Key:=Range( _
"D2:D11335"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Все должники").Sort
.SetRange Range("A1:O11335")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A2").Select

MsgBox "замен: " & par1 & vbCrLf & "удалено: " & par2 & vbCrLf & "добавлено: " & par3

End Sub

Код уж какой есть...извините. Ошибку макрос не выдаёт. Он отрабатывает до конца только не то делает что должен :) Более подробно...ну как-то так:

сначала он отфильтровывает все пустые ячейки в определённом столбце и удаляет их, затем запускается поиск по двум листам с переносом новой информации и заменой некоторых данных при совпадении значений в заданных ячейках. Те которые не найдены закрашиваются, так же как и добавленные. После этих манипуляций макрос упорядочивает бд по 3 значениям и выдаёт информацию столько-то замен, удалений, исправлений. На этом всё.
Если его запустить повторно, то складывается впечатление, что он перестаёт вообще видеть, что на листе 2 есть информация, а просто переносит всё с листа 3 окрашивая как вновь добавленное. причём делает это по верх имеющейся таблицы. Кто подскажет в чём причина и как его заставить работать безотказно?

Блин, я не знаю как проще описать. Суть не в том, что макрос ошибку выдаёт. Он работает как калашников - безотказно, но до момента применения сортировки.(её можно из кода удалить и тогда проблема исчезнет). Я думаю тут и код который я выложил не столь важен. Главное как избавиться от этого недуга. Или может можно как-то сортировать кодом (точнее наверное: каким кодом можно сортировать?) Может с ним работать будет. А что про F8. Можно по-подробней

Так чтоб всем понятней было. :) 1-ая часть макроса написана через кнопулечку записать макрос, 2-я написана для меня хорошим человеком, 3-я как вторая. Короче я этот код не писал, мне он просто как воздух нужен. Это раз.

И я так понял есть предположения, что манипуляции с листом три могут дать какой-то результат?