Метод Діапазон об'єкта не вдався 1004 - excel, vba, range

Я написав якийсь код, який працює відмінно, як він повинен, коли я його налагоджувати. Але коли я видаляю точку зупинки і просто запускаю код, це дає помилку під час виконання:

помилка під час виконання "1004" Не вдалося виконати діапазон методу object_worksheet.

Вона посилається на наступний рядок:

Set copyrange = sh.Range("A" & i & ":E" & i & ",I" & i & ":O" & i & ",Q" & i & ",V" & i) "name column in sheet  = Q

Але під час його налагодження немає проблеми. Можливо, кеш заповнений?

Private Sub btnGetDevices_Click()
"open every sheet after summary
"copy columns A,B,C,D,E,I,J,K,L,M,N,O, Q,V to summary

Dim sh As Worksheet
Dim copyrange As Range

Application.ScreenUpdating = False
Sheets("Summary").Rows(4 & ":" & Sheets("Summary").Rows.Count).Delete
For Each sh In ActiveWorkbook.Worksheets
If sh.Name <> "Database" And sh.Name <> "Template" And sh.Name <> "Help" And sh.Name <> "OVERVIEW" And sh.Name <> "Develop" And sh.Name <> "Schedule" And sh.Name <> "Information" And sh.Name <> "Announcements" And sh.Name <> "Summary" Then
sh.Select
LastRow = ActiveSheet.Range("L1048555").End(xlUp).Row

For i = 14 To LastRow

If sh.Range("Q" & i).Value <> Empty And sh.Range("N" & i).Value <> "Designer" And sh.Range("O" & i).Value <> "Layouter" Then
Set copyrange = sh.Range("A" & i & ":E" & i & ",I" & i & ":O" & i & ",Q" & i & ",V" & i) "name column in sheet  = Q
NameDevice = sh.Range("Q" & i).Value
adressDevice = sh.Range("Q" & i)
copyrange.Copy
Sheets("Summary").Select

LastRowsummary = ActiveSheet.Range("A1048555").End(xlUp).Row
Range("B" & LastRowsummary + 1).Select
ActiveSheet.Paste
Range("A" & LastRowsummary + 1) = sh.Name
Range("A" & LastRowsummary + 1, "O" & LastRowsummary + 1).Borders.LineStyle = xlContinuous

Sheets("Summary").Hyperlinks.Add anchor:=Sheets("Summary").Range("N" & LastRowsummary + 1), Address:="", SubAddress:=""" & sh.Name & ""!A1", TextToDisplay:=NameDevice
End If



Next


End If


Next
Application.ScreenUpdating = True

Sheets("Summary").Activate

End Sub

* редагувати: Після деякого тестування я помітив, що помилка пішла, коли я використовую весь діапазон стовпчиків замість деяких стовпців.

з помилкою:

Set copyrange = sh.Range("A" & i & ",V" & i)

без помилки:

Set copyrange = sh.Range("A" & i & ":E" & i)

* друге редагування:

Я використовую код від "Тіма Вільямса".

rw.Range("A1:E1,I1:O1,Q1,V1").Copy rng.Offset(0, 1)

Я знайшов обхідний шлях.

rw.Range("I1:O1").Copy rng.Offset(0, 6)
rw.Range("Q1").Copy rng.Offset(0, 13)
rw.Range("V1").Copy rng.Offset(0, 14)

Тепер це працює без помилок. Але якщо хтось знає, що викликає проблему, ви завжди можете поділитися нею. Заздалегідь спасибі.

* третє редагування:

Я все ще не знаю, чому він не працює. Це має відношення до діапазону з різних стовпців. Смішно (і дуже розчаровані частини) є те, що я використовую діапазон цей шлях в іншому аркуші, і там я не маю цієї проблеми.

Відповіді:

1 для відповіді № 1

Складено, але не перевірено "

Private Sub btnGetDevices_Click()
"open every sheet after summary
"copy columns A,B,C,D,E,I,J,K,L,M,N,O, Q,V to summary

Dim sh As Worksheet, shtsumm As Worksheet
Dim copyrange As Range, arrExclude, rw As Range
Dim lastRow As Long, i As Long, rng As Range
Dim NameDevice, adressDevice

"sheets to ignore
arrExclude = Array("Database", "Template", "Help", "OVERVIEW", _
"Develop", "Schedule", "Information", "Announcements", _
"Summary")

Set shtsumm = Sheets("Summary")

Application.ScreenUpdating = False

shtsumm.Rows(4 & ":" & shtsumm.Rows.Count).Delete
For Each sh In ActiveWorkbook.Worksheets

If IsError(Application.Match(sh.Name, arrExclude, 0)) Then

lastRow = sh.Cells(sh.Rows.Count, "L").End(xlUp).Row

For i = 14 To lastRow

Set rw = sh.Rows(i)

If rw.Cells(1, "Q").Value <> Empty And _
rw.Cells(1, "N").Value <> "Designer" And _
rw.Cells(1, "O").Value <> "Layouter" Then

NameDevice = rw.Range("Q1").Value
adressDevice = rw.Range("Q1").Value "<<<typo ?

"find destination
Set rng = shtsumm.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)

rng.Value = sh.Name
"Here Range is relative to *rw*, not to the whole sheet
rw.Range("A1:E1,I1:O1,Q1,V1").Copy rng.Offset(0, 1)
rng.Resize(1, 15).Borders.LineStyle = xlContinuous

shtsumm.Hyperlinks.Add _
anchor:=rng.EntireRow.Cells(1, "N"), _
Address:="", SubAddress:=""" & sh.Name & ""!A1", _
TextToDisplay:=NameDevice
End If
Next
End If
Next

Application.ScreenUpdating = True

shtsumm.Activate

End Sub

---