Option Explicit
Private Const TARGET_WORKSHEET = "Sheet1"
Private Sub Workbook_Open()
Call Me.Names.Add("BottomCell", Range(TARGET_WORKSHEET & "!" & Cells(Worksheets(TARGET_WORKSHEET).Rows.Count, 1).Address))
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Call Intercept_Rows_Add_Delete(Sh, Target)
End Sub
Private Sub Intercept_Rows_Add_Delete(ByVal Sh As Object, ByVal Target As Range)
Dim oRange As Range, sNameRefersTo As String, errNumber As Long
On Error Resume Next
Set oRange = Range("BottomCell")
errNumber = Err.Number
On Error GoTo 0
sNameRefersTo = "=" & TARGET_WORKSHEET & "!" & Cells(Worksheets(TARGET_WORKSHEET).Rows.Count, 1).Address
Select Case True
Case errNumber <> 0
Call Worksheet_RowInsert(Sh, Target)
Me.Names("BottomCell").Value = sNameRefersTo
Case Me.Names("BottomCell").Value <> sNameRefersTo
Call Worksheet_RowDelete(Sh, Target)
Me.Names("BottomCell").Value = sNameRefersTo
End Select
End Sub
[B][COLOR=#008000]'Pseudo_Events...
'================[/COLOR][/B]
Private Sub Worksheet_RowInsert(ByVal Sh As Object, ByVal Target As Range)
If Sh.Name = TARGET_WORKSHEET Then
[COLOR=#008000]' Debug.Print "Rows Inserted : " & vbCr & Target.Address[/COLOR]
Sheet2.Range(Target.Address).EntireRow.Insert
End If
End Sub
Private Sub Worksheet_RowDelete(ByVal Sh As Object, ByVal Target As Range)
If Sh.Name = TARGET_WORKSHEET Then
[COLOR=#008000]' Debug.Print "Rows Deleted : " & vbCr & Target.Address[/COLOR]
Sheet2.Range(Target.Address).EntireRow.Delete
End If
End Sub