Sub CompareMacro()
    Dim FilesToOpen
    Dim x As Integer
    Application.ScreenUpdating = False  'отключаем обновление экрана для скорости
   'вызываем диалог выбора файлов для импорта
    OpenPath = ThisWorkbook.Path
    ChDrive OpenPath
    ChDir OpenPath
    FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="All files (*.*), *.*", _
      MultiSelect:=True, Title:="Files to Merge") '.OpenPath = "C:\"
 
    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "Не выбрано ни одного файла!"
        Exit Sub
    End If
     
    'проходим по всем выбранным файлам
    Dim s(1 To 2) As String
    x = 1
    While x <= UBound(FilesToOpen)
        Set importWb = Workbooks.Open(Filename:=FilesToOpen(x))
        'For Each pj In Application.VBE.VBProjects
        Set pj = ActiveWorkbook.VBProject
            For Each vbcomp In pj.VBComponents
                If Not vbcomp Is Nothing Then
                    N = vbcomp.CodeModule.CountOfLines
                    If N > 0 Then
                        s(x) = s(x) + vbCrLf + "*****" + vbcomp.CodeModule.Name + "*****" + vbCrLf
                        s(x) = s(x) + vbcomp.CodeModule.Lines(1, N)
                    End If
                End If
            Next
        'Next
        importWb.Close False 'savechanges:=True
        x = x + 1
    Wend
    If s(1) <> s(2) Then [D1] = "Не совпадает" Else [D1] = "Совпадает"
    s3 = Split(s(1), vbCrLf)
    'cr = 1
    Columns("A:C").ClearContents
    arr1 = Range("A1:A" & UBound(s3) + 1)
    For i = 0 To UBound(s3)
        arr1(i + 1, 1) = s3(i)
    Next
    Range("A1:A" & UBound(arr1)) = arr1
    
    s4 = Split(s(2), vbCrLf)
    'cr = 1
    arr2 = Range("B1:B" & UBound(s4) + 1)
    For i = 0 To UBound(s4)
        arr2(i + 1, 1) = s4(i)
    Next
    Range("B1:B" & UBound(arr2)) = arr2
    If UBound(arr1) > UBound(arr2) Then lim = UBound(arr2) Else lim = UBound(arr1)
    For i = 1 To lim
        If arr1(i, 1) <> arr2(i, 1) Then Cells(i, "C") = 1
    Next
    Application.ScreenUpdating = True
    MsgBox "Процесс проверки успешно завершен!"
End Sub