object_worksheet的方法范围失败1004

我写了一些代码,它完美的工作,因为它应该当我debugging它。 但是,当我删除断点,只是运行代码,它给出了一个运行时错误:

运行时错误“1004”方法object_worksheet的范围失败。

它是指下一行:

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

但是在debugging的时候,没有问题。 也许caching已满?

 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 

*编辑 :经过一些testing,我注意到,当我使用全列的列而不是只有一些列时,错误消失了。

错误:

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

没有错误:

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

*第二编辑:

我正在使用“Tim Williams”的代码。 有同样的错误。 而不是使用:

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

我find了一个解决方法。 我把它分开。

 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) 

现在这个工作没有错误。 但是,如果有人知道是什么原因造成这个问题,你可以随时分享。 提前致谢。

*第三编辑:

我仍然不知道为什么它不工作。 这与不同栏目的范围有关。 有趣的(也是非常沮丧的部分)是我在另一张表中使用这种方法,在那里我没有这个问题。 这让我发疯。 有人有一个想法吗?

编译但未经testing“

 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