How do I delete entries from all worksheets at the same time?

Question

I have code to paste a value into all worksheets in a workbook (it does work but its a little slow).

Then it should when a value is deleted, delete that row from every other worksheet, but it does nothing.

Debugging it looks like the Application.CountBlank(irg) = 1 is never met even though IRG upon cell deletion as the target cell should definitely be blank and a delete should run the worksheet change event.

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

Answer 1

Please, try the next code. It assumes that Target may have more columns, but only one row:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  Const cCol As String = "A"
  Const fRow As Long = 2
  Dim crg As Range, ddFound As Range, ws As Worksheet, i As Long

 Application.EnableEvents = False

  Set crg = Columns(cCol).Resize(rows.Count - fRow + 1).Offset(fRow - 1)
  Dim irg As Range: Set irg = Intersect(crg, Target)
  If Target.rows.Count > 1 Then Exit Sub 'no more then one row admitted
  If irg Is Nothing Then Exit Sub
  Dim sraddress As String, ddcrg As Range
  Dim rngDelS As Range, rngDelJ As Range 'ranges to keep rows to be deleted

  For Each ws In ActiveWorkbook.Worksheets
   If ws.Index <= 13 Then
        Set ddcrg = ws.Columns(cCol)
        sraddress = irg.Value2
        Set ddFound = ddcrg.Find(sraddress, , xlValues, xlWhole)
    
         If irg.Value <> "" Then
            If ddFound Is Nothing Then
                ws.Range(irg.Address).Value2 = irg.Value2
            End If
        ElseIf irg.Value = "" And Not ddFound Is Nothing Then
                If rngDelS Is Nothing Then
                    Set rngDelS = Sheets("Statistics").Range(ddFound.Address)
                    Set rngDelJ = Sheets("January").Range(ddFound.Address)
                Else
                    Set rngDelS = Union(rngDelS, Sheets("Statistics").Range(ddFound.Address))
                    Set rngDelJ = Union(rngDelJ, Sheets("January").Range(ddFound.Address))
                End If
          End If
    End If
  Next ws
  If Not rngDelS Is Nothing Then 'delete the necessary rows, at once, per each sheet:
     rngDelS.EntireRow.Delete
     rngDelJ.EntireRow.Delete
  End If
  Application.EnableEvents = True
End Sub