VBA Why does Delete Shift Up delete everything below it?

Question

So my code whenever a name is added on a sheet then adds the name to all other sheets, and whenever a name is deleted from the same sheet it should be deleted from all other sheets (those are the selected sheets below). But for some reason running ActiveCell.EntireRow.Delete Shift:=xlUp deletes everything below ActiveCell too? Here is my entire code currently.

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

    Set crg = Worksheets("Statistics").Columns(cCol).Resize(Rows.Count - fRow + 1).Offset(fRow - 1)
    Dim irg As Range: Set irg = Intersect(crg, Target)
    Dim sraddress As String
    Dim statdel As Range
    
    Dim dws As Worksheet
    Dim ddcrg As Range
    Dim statrange As Range
    
    If Not Intersect(Target, Range("A:A")) Is Nothing Then
        sraddress = CStr(irg.Value)
        
        Application.ScreenUpdating = False
        Application.EnableEvents = False

        For Each ws In ActiveWorkbook.Worksheets
            Set ddcrg = ws.Columns(cCol)
            Set ddFound = ddcrg.Find(sraddress, , xlValues, xlWhole)
            
            If sraddress <> "" Then
                irg.Select:   ActiveCell = irg.Value2
                irg.Copy
                ws.Range(irg.Address) = irg.Value2
                Application.CutCopyMode = False
            ElseIf sraddress = "" Then
                Dim Deladdrs As String
                irg.EntireRow.Select
            
                On Error Resume Next

                Sheets(Array("Statistics", "January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December")).Select
            
                Deladdrs = ActiveCell.Address(0, 0)
                
                ActiveCell.EntireRow.Delete Shift:=xlUp
        
                Application.CutCopyMode = False
            Else
            End If
        Next ws
    
        Application.ScreenUpdating = True
        Application.EnableEvents = True
    Else
    End If
End Sub

Answer 1

Please, test the next code. It assumes that only the sheets in the array (from your code) should be updated. And also, in case of a name deletion, the row containing it should also be deleted. The code also covers the case of row deletion, which otherwise should place the value in A:A of the new Target on all row of the sheets to be updated:

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

    If Target.Rows.Count > 1 then exit sub. Not allowed more rows to be deleted, changed.
    If Not Intersect(Target, Range("A:A")) Is Nothing Then
        Set crg = Me.Columns(cCol).Resize(rows.Count - fRow + 1).Offset(fRow - 1)
        Set irg = Intersect(crg, Target)
        irgVal = irg.value
        If Target.Columns.Count = 16384 Then irgVal = "" 'for the case of deleting the whole row!
        Application.ScreenUpdating = False
        Application.EnableEvents = False

        For Each ws In Worksheets(Array("January", _
                               "February", "March", "April", "M)
            
            If irgVal <> "" Then
                ws.Range(Target.Address).value = irg.value
            Else
                ws.rows(irg.row).EntireRow.Delete
            End If
        Next ws
        If CStr(irg.value) = "" Then irg.EntireRow.Delete 'delete also the Target row...

        Application.ScreenUpdating = True
        Application.EnableEvents = True
    End If
End Sub

The above code is not designed for multiple rows deletion, change

An event triggering Row deletion (at Ribbon level) can be designed, but it does not make the object of the question...