Sub Прочитать_данные()

Const COUNT_ROW As Integer = 49             'количество проверяемых строк
Dim EtalonDirectory As String               'директория файла с эталонами
Dim EtalonBook As Workbook    '
Dim EtalonSheet As String    'название листа в файле с протоколом
Dim i, j, k As Integer                      'временные переменные
Dim EqualData As Boolean                    'флаг соответсвия даты в протоколе и файле с условиями

'открывем файл с эталоном, привязываем книги к переменным
EtalonDirectory = Cells(14, 9)
'проверим файл по директории
If Dir(EtalonDirectory) = "" Then
    MsgBox "Путь к файлу c описанием эталонных СИ указан не правильно"
Else
'    Set ProtocolBook = ActiveWorkbook
'    ProtocolSheet = ActiveWorkbook.ActiveSheet.Name
    Workbooks.Open (EtalonDirectory)
    Set EtalonBook = ActiveWorkbook
    EtalonSheet = "Условия"
    ThisWorkbook.Activate
    With EtalonBook.Worksheets(EtalonSheet)
        If (Cells(48, 4)) Then
            'просматриваем строки, при совпадении даты копируем в протокол
            If (Cells(30, 6) = "") Then
                Cells(30, 6) = Date
            End If
            EqualData = False
            i = 50
            While (i > 1)
                If (Cells(30, 6) = .Cells(i, 1)) Then
                    EqualData = True
                    j = 0
                    While (j <> 6)
                        Cells(32 + j, 4) = .Cells(i, 2 + j)
                        j = j + 1
                    Wend
                End If
                i = i - 1
            Wend
            'дата не совпала
            If (EqualData = False) Then
                j = 0
                While (j <> 6)
                    Cells(32 + j, 4) = "Отсутствует"
                    j = j + 1
                Wend
            End If
        End If
        EtalonSheet = "Общее"
        If (Cells(48, 5)) Then
            'копируем фамилию и букву босса
            Cells(40, 4) = .Cells(1, 2)
            If Cells(48, 2) = 2 Then
                r_ = 2
            Else
                r_ = 3
            End If
            Cells(40, 6) = .Cells(r_, 2)
            Cells(45, 4) = .Cells(4, 2)
        End If
    End With
    EtalonBook.Close False
End If
End Sub