Добрый день.
Есть одна проблемка, никак не могу найти причину.
Есть некие данные и необходимо разложить их по отдельным листам Excel, по принципу (в данном случае) один лист – одна кассета.
Что делаем: Копируем данные на следующий лист, удаляем все лишнее с текущего листа оставляя нужную кассету, со следующего листа убираем нужную кассету. И далее по циклу.
Но когда доходит до 56 листа (+- 2 в зависимости от данных) появляется ошибка:
Run-time error ‘1004’
Метод Copy из класса Worksheet завершен неверно.

После этого в документе нельзя скопировать (даже вручную) не одной страницы, новые же создаются.


Public Function Start()
Dim j_ As Integer
Dim sheetNo_ As Integer
Dim CassetaNo_ As String

j_beg = 2
sheetNo_ = 2
Cells(1.1).Select

CassetaNo_ = Sheets(2).Cells(2, 6) 'Первая кассета

Do Until IsEmpty(Sheets(sheetNo_).Cells(j_beg, 6))

On Error GoTo Err_Copy

Sheets(sheetNo_).Copy After:=Sheets(sheetNo_) 'копируем лист

j_ = j_beg + 1 'чистим текущий лист
Do Until IsEmpty(Sheets(sheetNo_).Cells(j_, 6))
If Sheets(sheetNo_).Cells(j_, 6) <> CassetaNo_ Then
Sheets(sheetNo_).Rows(j_).Delete
Else
j_ = j_ + 1
End If
Loop
If Sheets(sheetNo_).Cells(j_beg, 6) <> "" Then
Sheets(sheetNo_).Name = Sheets(sheetNo_).Cells(j_beg, 6)
Else
Sheets(sheetNo_).Name = "Null"
End If

j_ = j_beg 'чистим следущий лист от предыдущей кассеты
Do Until IsEmpty(Sheets(sheetNo_ + 1).Cells(j_, 6))
If Sheets(sheetNo_ + 1).Cells(j_, 6) = CassetaNo_ Then
Sheets(sheetNo_ + 1).Rows(j_).Delete
Else
j_ = j_ + 1
End If
Loop

sheetNo_ = sheetNo_ + 1
CassetaNo_ = Sheets(sheetNo_).Cells(j_beg, 6)

Loop
End Function

Да… Жаль.
Мысль о переполнении буфера родилась одной из первых.
Переделывать будет затруднительно т.к. логика работы затачивалась по пользователей: Все отчеты в одной книге, поиск нужной (несмотря на количество страниц 3-4 секунды) и печать одной кнопкой.
Спасибо, по крайней мере, дальнейшие поиски прекращаю. Буде думать, как вылечить причину, а не следствие.

Ура!
В процессе модернизации перевел программу на коннект через ADO. И, о чудо, программа заработала. С ходу обработала все страницы (63, больше данных пока нет). Никогда бы не подумал…

Собственно, выше приведенный код я не менял ни на один символ.
Изначально я использовал соединение с сервером через ODBC, сейчас поменял его на ADO. Запрос и данные те же.
Поэтому и не понимаю, как это могло повлиять.
Хотя гипотеза есть, возможно, ODBC сам забивал буфер и поэтому остальные данные туда не входили.
Варианты кода ODBC-ADO нужны?

'Запрос через ODBC

With ActiveSheet.QueryTables.Add(Connection:=Array(Array( _
"ODBC;DRIVER=SQL Server;SERVER=СЕРВЕР;UID=ЛОГИН;APP=Microsoft Office 2003;WSID=IT;DATABASE=БД;Trusted_Connection" _
), Array("=Yes")), Destination:=Range("A1"))
.Name = "Chenge"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.CommandText = "ЗАПРОС"
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=False
End With


'Запрос через ADO

Option Explicit
Const strConnect = "Provider=SQLOLEDB;Data Source=СЕРВЕР;database=БД;uid=ЛОГИН;pwd="
Dim cn1 As Object
Dim rst1 As Object
Public Function Change_Pro()
Dim strSQL As String

Set cn1 = CreateObject("ADODB.Connection") 'подключаемся к БД
cn1.Open strConnect
Set rst1 = CreateObject("ADODB.Recordset") 'рабочий рекордсет

strSQL = "ЗАПРОС"

Dim cmd1 As ADODB.Command
Set cmd1 = New ADODB.Command
Set cmd1.ActiveConnection = cn1
cmd1.CommandText = strSQL
cmd1.CommandTimeout = 600
Set rst1 = cmd1.Execute

With Range("A1")
.Borders.LineStyle = 1
.CopyFromRecordset rst1
End With
End Function