есть макрос для сбора файлов ексель в один, сегодня начала выскакивать ошибка "application - defined or object defined error", файлов 14, и выкидывает после 9!
Скрытый текст
Код
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
'создаем новый лист в книге для сбора
ThisWorkbook.Sheets.Add After:=Sheets(Sheets.Count)
Set wsDataSheet = ThisWorkbook.ActiveSheet
'цикл по книгам
For li = LBound(avFiles) To UBound(avFiles)
If bPolyBooks Then Workbooks.Open Filename:=avFiles(li)
oAwb = Dir(avFiles(li), vbDirectory)
'цикл по листам
For Each wsSh In Workbooks(oAwb).Sheets
If wsSh.Name Like sSheetName Then
'Если имя листа совпадает с именем листа, в который собираем данные
'и сбор идет только с активной книги - то переходим к следующему листу
If wsSh.Name = wsDataSheet.Name And bPolyBooks = False Then GoTo NEXT_
With wsSh
Select Case iBeginRange.Count
Case 1 'собираем данные начиная с указанной ячейки и до конца данных
lLastrow = .Cells(1, 1).SpecialCells(xlLastCell).Row
iLastColumn = .Cells.SpecialCells(xlLastCell).Column
sCopyAddress = .Range(.Cells(iBeginRange.Row, iBeginRange.Column), .Cells(lLastrow, iLastColumn)).Address
Case Else 'собираем данные с фиксированного диапазона
sCopyAddress = iBeginRange.Address
End Select
lLastRowMyBook = wsDataSheet.Cells.SpecialCells(xlLastCell).Row + 1
'вставляем имя книги, с которой собраны данные
[COLOR=#ff0000] If lCol Then wsDataSheet.Cells(lLastRowMyBook, 1).Resize(Range(sCopyAddress).Rows.Count).Value = oAwb[/COLOR]
.Range(sCopyAddress).Copy wsDataSheet.Cells(lLastRowMyBook, 1).Offset(, lCol)
End With
End If
NEXT_:
Next wsSh
If bPolyBooks Then Workbooks(oAwb).Close False
Next li
With Application
.ScreenUpdating = True: .EnableEvents = True: .Calculation = lCalc
End With
End Sub
И в код, и под спойлер. Пользуйтесь кнопками форматирования сообщения Лучше было в файле показать [МОДЕРАТОР]
Какой знакомый код :-) Явно мой. Проверьте, не находится ли Excel в режиме совместимости и сколько при этом строк в общей сложности во всех файлах для сбора. Возможно именно на 9-м их кол-во превышает 65536. Чтобы избежать - надо сохранить файл с кодом в новом формате - "Книга Excel с поддержкой макросов". И так же надо закрыть все файлы 2003 Excel. Если данные собираются так же с файлов 2003 Excel(.xls) - лучше их так же пересохранить в одном из новых форматов.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
Я уже и не помню, где впервые его выложил....но именно тот код, что в первом сообщении этой темы точно не первоначальный код - это код с моего сайта, который претерпел определенные изменения.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...