Ｅｘｃｅｌ2013vbaでコード実行後も連続コピペ

質問

エクセル2013のVBAで、ワークシートに、条件付き書式を削除して再入力するように下記コードを記載したいのですが、これをするとセルをコピーして貼り付けを1度はできますが、連続でコピーすることができなくなります。
連続コピーもできるようにするやり方は何かあるのでしょうか？
ワークシートの、Private Sub Worksheet_Change(ByVal Target As Excel.Range)には、VLookupで参照するほかのコードも記載してあるので、他のイベントは使用できません。
条件付き書式がセルのコピペで増殖してフリーズしてしまうので、それを回避したいのです。現在はとりあえず、標準モジュールに記載して、適当な時にボタンを押すようにして使っています。

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

Dim ac As Range
Dim fc1 As FormatCondition
Dim fc2 As FormatCondition
Dim fc3 As FormatCondition
Dim h As Range
Set ac = ActiveCell
Range("B5:AK175").FormatConditions.Delete
With Range("$C$5:$C$175,$I$5:$I$175,$O$5:$O$175,$U$5:$U$175,$AA$5:$AA$175,$AG$5:$AG$175").FormatConditions

Set fc1 = .Add(Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="AAA")
fc1.Font.ColorIndex = 3
fc1.Font.Bold = True
Set fc2 = .Add(Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="BBB")
fc2.Font.ColorIndex = 5
fc2.Font.Bold = True
End With

With Range("$D$5:$D$175,$J$5:$J$175,$P$5:$P$175,$V$5:$V$175,$AB$5:$AB$175,$AH$5:$AH$175").FormatConditions
Range("D5").Select
Set fc3 = .Add(Type:=xlExpression, _
Formula1:="=IF(COUNTIF(C5,""AAA"")+COUNTIF(C5,""BBB""),1,0)")
fc3.NumberFormat = """(""#"")"""

End With

ac.Select

End Sub

回答No.1

keithin

＞連続コピーもできるようにするやり方は何かあるのでしょうか？

ありません。
マクロが作動するとコピー状態は解除され、連続貼り付けする事はできなくなります。

（自動起動）マクロを諦めて、コピー状態を継続するように工夫してください。