Запуск макроса при изменении адреса цели

Question

У меня есть оператор If, который выполняется при изменении ячейки. Эта часть работает нормально. Однако, когда он запускает макрос, по какой-то причине он добавляет около 40 дополнительных строк. Я использовал точку останова и обнаружил, что строки добавляются после специальной вставки. Может ли кто-нибудь сказать мне, почему?

Заранее спасибо.

Private Sub Worksheet_Change(ByVal Target As Range) 

If Target.Address = "$AG$4" Then 

Call CapEx_Copy_Paste_Delete 

End If 

End Sub 

Sub CapEx_Copy_Paste_Delete() 
' 
' CapEx_Copy_Paste_Delete Macro 
' 

' 
    Rows("11:11").Select 

    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
    Range("B4:AG4").Select 
    Selection.Copy 
    Range("B11").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 
    Range("AG4").Select 
    Selection.ClearContents 
    Range("B4:E4").Select 
    Selection.ClearContents 
    Range("H4:I4").Select 
    Selection.ClearContents 
    Range("L4:M4").Select 
    Selection.ClearContents 
    Range("P4:Q4").Select 
    Selection.ClearContents 
    Range("T4:U4").Select 
    Selection.ClearContents 
    Range("X4:Y4").Select 
    Selection.ClearContents 
    Range("Z4").Select 
    Selection.ClearContents 
    Range("AA4").Select 
    Selection.ClearContents 
    Range("AC4").Select 
    Selection.ClearContents 
    Range("AD4").Select 
    Selection.ClearContents 
    Range("B4").Select 
End Sub 

Answer 1

ли эту работу лучше ??:

Private Sub Worksheet_Change(ByVal Target As Range) 
    If Target.Address = "$AG$4" Then 
     Application.EnableEvents = False 
      Call CapEx_Copy_Paste_Delete 
     Application.EnableEvents = True 
    End If 
End Sub 

Answer 2

Вот версия аккуратнее вашего кода. Вполне вероятно, все, что использование Select не помогает ваши проблемы:

Private Sub Worksheet_Change(ByVal Target As Range) 
    If Target.Address = "$AG$4" Then 
     Application.EnableEvents = False 
      Call CapEx_Copy_Paste_Delete 
     Application.EnableEvents = True 
    End If 
End Sub 

Sub CapEx_Copy_Paste_Delete() 
    Dim ws As Worksheet 
    Dim arrRanges As Variant, v As Variant 

    'set this as the worksheet you want to update 
    Set ws = ThisWorkbook.Worksheets("Sheet1") 

    'set this as the ranges you want to clear 
    arrRanges = Array("AG4", "B4:E4", "H4:I4", "L4:M4", "P4:Q4", "T4:U4", "X4:Y4", "Z4") 

    With ws 
     .Rows("11:11").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 

     .Range("B4:AG4").Copy 
     .Range("B11").PasteSpecial Paste:=xlPasteValues 

     For Each v In arrRanges 
      .Range(v).ClearContents 
     Next v 
    End With 
End Sub 

---

Обновлено включить предложение Гэри Стьюдента - все заслуга его предложившего отключить события в первом суб