2015-05-22 2 views
0

У меня есть код, первоначально измененный с here. Когда в первом столбце строки есть C, строка удаляется и сохраняется на другом листе. Это приложение для списка дел.Ошибка времени выполнения '1004' «Метод копирования класса диапазона сбой» при смене ОС

Option Explicit 

Private Sub Worksheet_Change(ByVal Target As Range) 
    ' Code goes in the Worksheet specific module 
    Dim rng As Range 
     ' Set Target Range 
     Set rng = Target.Parent.Range("A1:A200") 
      ' Only look at single cell changes 
      If Target.Count > 1 Then Exit Sub 
      ' Only look at that range 
      If Intersect(Target, rng) Is Nothing Then Exit Sub 
      ' Action if Condition(s) are met 
      Select Case Target.Text 
       Case "C" 
        Target.EntireRow.Copy Sheets("Completed").Cells(Rows.Count, "A").End(xlUp).Offset(1) 
        Target.EntireRow.Delete 



      End Select 

End Sub 

код прекрасно работает на Excel 2010, но не с этой ошибкой:

Run time error '1004' "Copy Method of Range Class Failed" 

enter image description here

ответ

1

Это то, что вы пытаетесь? Вам нужно отключить другие события. Target.EntireRow.Delete проигнорирует событие. Вы также можете увидеть This

Option Explicit 

Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim lRow As Long 

    '~~> For Excel 2007+ 
    'If Target.Cells.CountLarge > 1 Then Exit Sub   
    If Target.Cells.Count > 1 Then Exit Sub 

    On Error GoTo Whoa 

    Application.EnableEvents = False 

    If Not Intersect(Target, Range("A1:A200")) Is Nothing Then 
     If Target.Value = "C" Then 
      With Sheets("Completed") 
       '~~> Find next available row in the output sheet 
       lRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1 

       Target.EntireRow.Copy .Rows(lRow) 
       Target.EntireRow.Delete 
      End With 
     End If 
    End If 

Letscontinue: 
    Application.EnableEvents = True 
    Exit Sub 
Whoa: 
    MsgBox Err.Description 
    Resume Letscontinue 
End Sub 
+0

'On Error GoTo Whoa' программирует золото! – FreeMan

0
Sheets("Completed").Cells(Rows.Count, "A").End(xlUp).Offset(1) 

потребности быть

Sheets("Completed").Cells(Sheets("Completed").Rows.Count, "A").End(xlUp).Offset(1) 
Смежные вопросы