Sub Insert_Rows()
Dim ws As Worksheet

r = ActiveCell.Row
c = Selection.Rows.Count
For Each ws In ThisWorkbook.Sheets
[COLOR=#ff0000]    If ws.Name <> "ТПВ" Then[/COLOR]
            ws.Range("C" & r & ":C" & r + c - 1).EntireRow.Insert
    End If
Next

End Sub

Sub Delete_Rows()
'
'
Dim ws As Worksheet
r = ActiveCell.Row
c = Selection.Rows.Count

For Each ws In ThisWorkbook.Sheets
 [COLOR=#ff0000]   If ws.Name <> "ТПВ" Then[/COLOR]
           ws.Range("C" & r & ":C" & r + c - 1).EntireRow.Delete
    End If
Next
End Sub

Option Explicit

'Private Sub Worksheet_Change(ByVal Target As Range)
'Dim i As Long
'Dim x As Long
'Dim n As String
'
'
'n = Me.Name
'i = Sheets(1).Range("IV1").Value
'If Me.UsedRange.Rows.Count = i Then Exit Sub
'    If Target.Cells.Count = Target.EntireRow.Cells.Count Then
'
'    x = Target.Row
'    If Me.UsedRange.Rows.Count > i Then
'        Call Insert_Rows(x, n)
'    Else
'        Call Delete_Rows(x, n)
'10
'    End If
'End If
'Sheets(1).Range("IV1").Value = Me.UsedRange.Rows.Count
'End Sub