¿Cómo elimino las entradas de todas las hojas de cálculo al mismo tiempo?

Tengo código para pegar un valor en todas las hojas de un libro de trabajo (funciona, pero es un poco lento).

Luego, cuando se elimina un valor, debería eliminar esa fila de todas las demás hojas de cálculo, pero no hace nada.

Al depurar, parece que nunca se cumple la condición Application.CountBlank(irg) = 1, aunque IRG debería estar en blanco al eliminar la celda de destino y debería ejecutarse el evento de cambio de hoja de cálculo.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Const cCol As String = "A"
Const fRow As Long = 2

Dim crg As Range
Dim ddFound As Range
Dim ws As Worksheet
Dim sh As Worksheet
Dim outpt As String

Dim i As Integer

Application.EnableEvents = False

Set crg = Columns(cCol).Resize(Rows.Count - fRow + 1).Offset(fRow - 1)
Dim irg As Range: Set irg = Intersect(crg, Target)
Dim sraddress As String

Dim dws As Worksheet
Dim ddcrg As Range

For Each ws In ActiveWorkbook.Worksheets

    Set ddcrg = ws.Columns(cCol)
    sraddress = irg.Value2
    Set ddFound = ddcrg.Find(sraddress, , xlValues, xlWhole)

    Application.ScreenUpdating = False

    If Application.CountBlank(irg) = 0 Then

        If ddFound Is Nothing Then
            irg.Select:   ActiveCell = irg.Value2
            irg.Copy
            ws.Range(irg.Address) = irg.Value2
            Application.CutCopyMode = False

        ElseIf Application.CountBlank(irg) = 1 And ddFound Is Nothing Then
            Sheets(Array("Statistics", "January")).Select
            ddFound.EntireRow.Delete Shift:=xlShiftUp

        End If
    End If

Next ws

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub