Dim i As Integer, j As Integer
Dim xlApp As New Excel.Application
Dim xlBook As Excel.Workbook, xlBook1 As Excel.Workbook, xlBook2 As Excel.Workbook
Dim xlSheet As Excel.Worksheet, xlSheet1 As Excel.Worksheet, xlSheet2 As Excel.Worksheet

Const PathResFile As String = "C:\Сравнение справок\"
Const Path1File As String = PathResFile & "Новые таблицы\"
Const Path2File As String = PathResFile & "Эталон\"

Sub Макрос1()
'
' Макрос1 Макрос
' Макрос записан 18.02.2009 (Azeke)
'
    Dim t As Integer, ii As Integer, jj As Integer
    Dim n As String
    
    Set xlBook = GetObject(PathResFile & "\Проверка.xls")
    For t =  1  To  22 
        Set xlSheet = xlBook.Sheets(CStr(t))
        Select Case t
            Case  2 ,  4 ,  7 ,  19 : n = "Лист1"
            Case  20 : n = "Нормообразующие показатели"
            Case Else: n = "Страница 1"
        End Select
        ii = Choose(t,  12 ,  7 ,  4 ,  10 ,  6 ,  8 ,  7 ,  4 ,  8 ,  8 ,  8 ,  10 ,  6 ,  8 ,  7 ,  4 ,  13 ,  7 ,  9 ,  4 ,  6 ,  5 )
        jj = Choose(t,  4 ,  3 ,  2 ,  2 ,  6 ,  6 ,  2 ,  2 ,  5 ,  4 ,  5 ,  3 ,  5 ,  3 ,  4 ,  3 ,  3 ,  3 ,  3 ,  2 ,  9 ,  7 )
        
        Set xlBook1 = GetObject(Path1File & CStr(t) & ".xls")
        Set xlSheet1 = xlBook1.Sheets(n)
        Set xlBook2 = GetObject(Path2File & CStr(t) & ".xls")    'ошибка выходит при выполнении этой стоки
        Set xlSheet2 = xlBook2.Sheets(n)
    
        Call Sravnenie(ii, jj)

        Set xlSheet1 = Nothing: Set xlSheet2 = Nothing
        xlBook1.Close: xlBook2.Close
        Set xlBook1 = Nothing: Set xlBook2 = Nothing
    Next
    MsgBox "Все !"
End Sub


Private Sub Sravnenie(iRow As Integer, jCol As Integer)
    j = jCol
    Do While (xlSheet1.Cells(iRow -  1 , j) <> "")
        i = iRow
        Do While (xlSheet1.Cells(i, jCol -  1 ) <> "")
            If xlSheet1.Cells(i, j) = "" And xlSheet2.Cells(i, j) = "" Then
                xlSheet.Cells(i, j) = CDbl(xlSheet1.Cells(i, j)) - CDbl(xlSheet2.Cells(i, j))
            Else
                xlSheet.Cells(i, j) = CDbl(Replace(xlSheet1.Cells(i, j), ".", ",")) - CDbl(Replace(xlSheet2.Cells(i, j), ".", ","))
            End If
            i = i +  1 
        Loop
        j = j +  1 
    Loop
End Sub