ошибки «Application или объект определяется ошибка» в Excel макрос

Question

Этого кода петли дважды, затем останавливается с ошибкой «Применение определяется или ошибка объекта определяется»

Sub addsheet() 
Dim Copyrange As String 
Dim Copyrange2 As String 
Dim lastRow As Long 
lastRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row 
MsgBox lastRow 
Dim newsheet 
Set newsheet = Sheets.Add(After:=Sheets(Worksheets.Count), Count:=1, Type:=xlWorksheet) 
newsheet.Name = "Consol" 
Startrow = 1 
Do While Not IsEmpty(Worksheets("Sheet1").Range("E1").Value) 
For i = Startrow To lastRow 
     For j = 1 To 1 
      Worksheets("Consol").Cells(i, j) = Worksheets("Sheet1").Range("E1").Value 
     Next j 
     Next i 

    Let Copyrange = "B" & Startrow & ":" & "F" & lastRow 
    Let Copyrange2 = "A1" & ":" & "E" & lastRow 
    Worksheets("Consol").Range(Copyrange).Value = Worksheets("Sheet1").Range(Copyrange2).Value 
    Columns("E").Delete 
    Startrow = Startrow + lastRow 
    lastRow = lastRow + lastRow 
Loop 
End Sub 

Answer 1

Вы получаете свою ошибку, потому что вы Арен» t удовлетворяя условию выхода для цикла до того, как он выполнит максимум 21 раз (и затем переполнит количество строк в листе Excel). Вы правильно иметь lastRow набор как Long, так переменная не переполнение, но эта строка кода ...

lastRow = lastRow + lastRow 

... двойников счетчика строк вы пытаетесь обратиться каждый раз через петлю. Ошибка приложения возникает, когда вы пытаетесь получить доступ к ячейке в строке выше максимального значения 1048576. Таким образом, если вы начинаете с lastRow из 1, она будет удваиваться 21 раз, прежде чем она станет выше 1048576. Если вы начинаете с более чем 1 ряд, это идет намного быстрее.

Я не выяснен код гораздо дальше, чем это, но вы, вероятно, просто нужно использовать другой счетчик строк внутри цикла:

UNTESTED:

Startrow = 1 
Dim currentEnd As Long 
currentEnd = lastRow 
Do While Not IsEmpty(Worksheets("Sheet1").Range("E1").Value) 
    For i = Startrow To currentEnd 
     Worksheets("Consol").Cells(i, 1) = Worksheets("Sheet1").Range("E1").Value 
    Next i 

    Copyrange = "B" & Startrow & ":" & "F" & lastRow 
    Copyrange2 = "A1" & ":" & "E" & lastRow 
    Worksheets("Consol").Range(Copyrange).Value = Worksheets("Sheet1").Range(Copyrange2).Value 
    Columns("E").Delete 
    lastRow = currentEnd + lastRow 
    Startrow = lastRow 
Loop