Сравнение шапок

[vasa11]

Здравствуйте, уважаемые гуру!
Есть такая задача - сравнить два диапазона Excel.
Нужно, чтобы макрос сравнивал, именно выделенный диапазон.
Всем буду очень признателен за ответ!

[SAS888]

vasa11
Какие диапазоны нужно сравнивать?
Где выделенные диапазоны?
Что конкретно значит "сравнить"?

Предлагаю код, который сравнивает два диапазона на полное совпадение данных.

Sub CompareRanges()
    Dim x As Range, y As Range
    Set x = [A1:A10] 'Диапазон 1
    Set y = [B1:B10] 'Диапазон 2
    If Evaluate("AND(" & x.Address & "=" & y.Address & ")") Then
        'Действия, если данные в диапазонах совпадают
    Else
        'Действия, если данные в диапазонах не совпадают
    End If
End Sub

[vasa11]

Диапазон выбирается любой через Application.InputBox
Sub CompareBooks()
Dim xWb As Workbook
Dim xAddWb As Workbook
Dim xRng1 As Range
Dim xRng2 As Range
Set xWb = Application.ActiveWorkbook
xTitleId = "Выбор файлов для обработки"
With Application.FileDialog(msoFileDialo gOpen)
.Filters.Clear
.Filters.Add "Excel 2007-19", "*.xlsx; *.xlsm; *.xls; *.xlsa"
.AllowMultiSelect = False
.ButtonName = "OK"
.Show
If .SelectedItems.Count = 0 Then Exit Sub
Application.Workbooks.Open .SelectedItems(1)
Set xAddWb = Application.ActiveWorkbook
On Error Resume Next
Set xRng1 = Application.InputBox(Prompt:=" Выберите наименование строк можно мышкой или написать диапазон для обработки ", Title:=xTitleId, Default:="", Type:=8)
MsgBox " выбран диапазон" & xRng1.Address

If xRng1 Is Nothing Then
MsgBox "Отмена выполнения", vbCritical, "Нет данных"
Exit Sub
End If
Application.ScreenUpdating = False
End With
'Проверка,сравнение названий/расположения выбранного диапазона с диапазоном листа шапка
Header

End Sub

Sub Header()
Dim dpn, wsL As Worksheet, rc As Range
dpn = "c4:H4" 'адрес эталонной шапки
Set wsL = ThisWorkbook.Sheets("шапка") 'лист с эталонной шапкой, может быть скрытым
For Each rc In wsL.Range(dpn).Cells
' rc.Value строка и столбец Sheets("шапка")
' ActiveSheet.Cells(rc.Row, rc.Column) строка и столбец активной книги,с которой сравниваем
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> >>>>>>
'сейчас проверяется строка 4 и столбцы 3 по 6 активной книги, а надо чтобы проверялся выделеный диапазон xRng1.Address
If rc.Value <> ActiveSheet.Cells(rc.Row, rc.Column).Value Then
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> >>>>>
MsgBox " столбец шапки выбраного документа не совпадает с образцом! " & rc.Value & vbNewLine & "Для дальнейшей работы необходимо форматировать импортную таблицу чтобы шапка соответствовала шаблону", vbInformation, "проверка шапки на совпадение с образцом"
Exit Sub
End If
Next
MsgBox " шапки документов совпадает", vbInformation, "Проверка"
End Sub
у меня не присоединился макросы поэтому выкладываю отдельно

[SAS888]

Файлы, содержащие макросы, требуется прикреплять в архиве.
Посмотрите пример во вложении.
Лист с шаблоном "шапки" скрыт.
Сама "шапка" может содержать произвольное количество строк и столбцов (в примере это диапазон "C4:H4").
Если в выделенном диапазоне "шапки" для сравнения количество строк или столбцов не соответствует шаблону, то макрос выдаст соответствующее предупреждение.
Проверяйте. Все ли так, как Вам нужно?

[vasa11]

Спасибо.Макрос отлично справляется с задачей.
Но по сколько "шапка" может содержать произвольное количество строк и столбцов,что несомненно большой плюс,то напрашивается вопрос? Как изменить Set x = ThisWorkbook.Sheets("шапка").Range( "C4:H4") 'диапазон эталонной шапки ,в редакторе не открывая его ведь не каждый пользователь знает VBA чтобы изменить эту строку.Может через отдельную форму задать диапазон?

[IgorGO]

  Set x = Application.InputBox("Отметьте мышью нужный диапазон", Type:=8)

[vasa11]

Спасибо.Но если добавить конструкцию т.е. задействовать кнопку отмена:
Dim x As Range
Set x = Application.InputBox("Отметьте мышью нужный диапазон", Type:=8)
If Err <> 0 Then
MsgBox "Отмена выполнения", vbCritical, "Нет данных": Exit Sub
End If
не работает.

[vasa11]

виноват забыл вставить On Error Resume Next
Файл рабочий,помощь оказана.Благодарю всех за оказанное внимание.

[vasa11]

SAS888
Подскажите,пожалуйста,как объединить 2 макроса CompareBooks и Sub Header(y As Range) в один макрос

[SAS888]

Пример во вложении.