Sub Consolidated_Range_of_Books_and_Sheets()
Dim iBeginRange As Object, lCalc As Long, lCol As Long
Dim oAwb As String, sCopyAddress As String, sSheetName As String
Dim lLastrow As Long, lLastRowMyBook As Long, li As Long, iLastColumn As Integer
Dim wsSh As Object, wsDataSheet As Object, bPolyBooks As Boolean, avFiles

On Error Resume Next
'Âûáèðàåì äèàïàçîí âûáîðêè ñ êíèã
Set iBeginRange = Application.InputBox("Âûáåðèòå äèàïàçîí ñáîðà äàííûõ." & vbCrLf & _
"1. Ïðè âûáîðå òîëüêî îäíîé ÿ÷åéêè äàííûå áóäóò ñîáðàíû ñî âñåõ ëèñòîâ íà÷èíàÿ ñ ýòîé ÿ÷åéêè. " & _
vbCrLf & "2. Ïðè âûäåëåíèè íåñêîëüêèõ ÿ÷ååê äàííûå áóäóò ñîáðàíû òîëüêî ñ óêàçàííîãî äèàïàçîíà âñåõ ëèñòîâ.", Type:=8)
'Åñëè äèàïàçîí íå âûáðàí - çàâåðøàåì ïðîöåäóðó
If iBeginRange Is Nothing Then Exit Sub
'Óêàçûâàåì èìÿ ëèñòà
'Äîïóñòèìî óêàçûâàòü â èìåíè ëèñòà ñèìâîëû ïîäñòàâêè ? è *.
'Åñëè óêàçàòü òîëüêî * òî äàííûå áóäóò ñîáèðàòüñÿ ñî âñåõ ëèñòîâ
sSheetName = InputBox("Ââåäèòå èìÿ ëèñòà, ñ êîòîðîãî ñîáèðàòü äàííûå(åñëè íå óêàçàí, òî äàííûå ñîáèðàþòñÿ ñî âñåõ ëèñòîâ)", "Ïàðàìåòð")
'Åñëè èìÿ ëèñòà íå óêàçàíî - äàííûå áóäóò ñîáðàíû ñî âåõ ëèñòîâ
If sSheetName = "" Then sSheetName = "*"
On Error GoTo 0
'Çàïðîñ ñáîðà äàííûõ ñ êíèã(åñëè Íåò - òî ñáîð èäåò ñ àêòèâíîé êíèãè)
If MsgBox("Ñîáðàòü äàííûå ñ íåñêîëüêèõ êíèã?", vbInformation + vbYesNo, "Excel-VBA") = vbYes Then
avFiles = Application.GetOpenFilename("Excel files(*.xls*),*.xls*", , "Âûáîð ôàéëîâ", , True)
If VarType(avFiles) = vbBoolean Then Exit Sub
bPolyBooks = True
lCol = 1
Else
avFiles = Array(ThisWorkbook.FullName)
End If
'îòêëþ÷àåì îáíîâëåíèå ýêðàíà, àâòîïåðåñ÷åò ôîðìóë è îòñëåæèâàíèå ñîáûòèé
'äëÿ ñêîðîñòè âûïîëíåíèÿ êîäà è äëÿ èçáåæàíèÿ îøèáîê, åñëè â êíèãàõ åñòü èíûå êîäû
With Application
lCalc = .Calculation
.ScreenUpdating = False: .EnableEvents = False: .Calculation = xlManual
End With