Добрый день, уважаемые коллеги,

Подскажите, пож-та, запускаю макрос, такая ошибка: "Run-time error 1004"
И в коде выделяется желтым следующий код:
iLastRowBaza = BazaSht.Cells(Rows.Count, 3).End(xlUp).Row

Помогите, плиз!

Полный текст ошибки:
Run-time error 1004:
Application-defined or object-defined error.

Полный год:

Option Explicit

Sub CombineTables()
Dim BazaWb As Workbook 'текущая книга (общий файл)
Dim BazaSht As Worksheet 'лист База покупателей в общем файле
Dim iTempFileName As String 'имя по-очерёдно открываемого файла
Dim iPath As String 'путь к папке, где лежат все файлы
Dim iLastRowBaza As Long 'последняя заполненная строка в общем файле в столбце A
Dim iLastRowTempWb As Long 'последняя заполненная строка в по-очерёдно открываемом файле в столбце A
Dim iLastColTempWb 'последний столбец с инфо в по-очерёдно открываемом файле
Dim iNumFiles As Long 'количество открываемых файлов
Dim IsHeader As Boolean 'скопирована ли шапка таблицы
Dim NumberRng As Range 'ячейка с Number
Dim firstAddress As String
Dim n As Long 'счётчик
Dim iLastRowTbl As Long 'номер последний строки в текущей таблице
Dim iTablesCnt As Long 'количество скопированных таблиц

With Application
.ScreenUpdating = False
.DisplayAlerts = False
.Calculation = xlManual
Set BazaWb = ThisWorkbook
Set BazaSht = BazaWb.Sheets.Add
iPath = BazaWb.Path & "\"
iTempFileName = Dir(iPath & "*.xls")
Do While iTempFileName <> ""
If iTempFileName = BazaWb.Name Then GoTo iNext:
With .Workbooks.Open _
(Filename:=iPath & iTempFileName, UpdateLinks:=False, ReadOnly:=True)
If Not IsShtPresent("Example") Then
Application.ScreenUpdating = True
MsgBox "Листа с названием ""Example"" в активной книге нет! ", 48, "Ошибка"
Exit Sub
End If
iNumFiles = iNumFiles + 1
'Рабочая книга не должна быть защищена паролем
With .Worksheets("Example")
.UsedRange.EntireRow.Hidden = False
.UsedRange.RowHeight = 12.75
'ищем ячейку с надписью Number
Set NumberRng = .Columns(2).Find(What:="Number", LookIn:=xlFormulas, LookAt:=xlWhole)
'номер последней заполенной строки в столбце С
iLastRowTempWb = .Cells(Rows.Count, 3).End(xlUp).Row
iLastColTempWb = .UsedRange.Columns.Count
If Not NumberRng Is Nothing Then
If Range(NumberRng.Address).MergeCells = True Then Range(NumberRng.Address).UnMerge
firstAddress = NumberRng.Address
Do
If Not IsHeader Then
'если копируем первый раз, то копируем таблицу с шапкой
'узнаём сколько строк в текущей таблице будем копировать
For n = NumberRng.Offset(2, 1).Row To iLastRowTempWb + 1
If Cells(n, 3) = "" Then
iLastRowTbl = n - 1
Exit For
End If
Next n
iLastRowBaza = BazaSht.Cells(Rows.Count, 3).End(xlUp).Row If iLastRowBaza > 1 Then iLastRowBaza = iLastRowBaza + 1
.Range(.Cells(1, 1), .Cells(iLastRowTbl, iLastColTempWb)).Copy Destination:=BazaSht.Cells(iLastRowBaza, 1)
IsHeader = True
iTablesCnt = iTablesCnt + 1
Else
'для всех последующих копирований - без шапки
'узнаём сколько строк в текущей таблице будем копировать
For n = NumberRng.Offset(2, 1).Row To iLastRowTempWb + 1
If Cells(n, 3) = "" Then
iLastRowTbl = n - 1
Exit For
End If
Next n
iLastRowBaza = BazaSht.Cells(Rows.Count, 3).End(xlUp).Row + 1
.Range(.Cells(NumberRng.Offset(2, 0).Row, 2), .Cells(iLastRowTbl, iLastColTempWb)).Copy Destination:=BazaSht.Cells(iLastRowBaza, 2)
iTablesCnt = iTablesCnt + 1
End If
Set NumberRng = .Columns(2).FindNext(NumberRng)
If Range(NumberRng.Address).MergeCells = True Then Range(NumberRng.Address).UnMerge
Loop While Not NumberRng Is Nothing And NumberRng.Address <> firstAddress
Else
Application.ScreenUpdating = True
MsgBox "Неправильная шапка таблицы! Не найдена ячейку ""Number"" в столбце B", vbExclamation, "Ошибка"
Exit Sub
End If
End With
.Close saveChanges:=False
End With
iNext:
iTempFileName = Dir
Loop
Range("B2:B3").Merge
Columns("B:D").AutoFit
.Calculation = xlAutomatic
.DisplayAlerts = True
.ScreenUpdating = True
End With
MsgBox "Информация собрана из " & iNumFiles & " файлов" & vbCr & _
"Скопировано " & iTablesCnt & " таблиц", vbInformation, "Объединение таблиц"
End Sub

Function IsShtPresent(iShtName As String) As Boolean
'проверяем существование листа в книге
Dim iShtTest As Worksheet
On Error Resume Next
Set iShtTest = ActiveWorkbook.Sheets(iShtName)
If iShtTest Is Nothing Then
IsShtPresent = False
Else
IsShtPresent = True
End If
End Function

Да, ок.

А в чем ошибка-то?

Высылаю файл с макросом

А у меня почему-то ошибка выходит.....

Shocker.ProAndreTMСкажите, ROWS здесь какого объекта?А какая разница? Фактически он сюда константу пишет 65535 для экселя до 2007 и скокататам - после.

Может это ошибка из-за несоответствия екселей 2003 и 2007?

Спасибо, вроде помогло!
Только число 60000 написал, все ок,
А 1000000 написал - опять ошибка...