Auto Add Row
Hi Brian,
you can easily adapt Tom's code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
dim nName as name
On Error GoTo ErrHandler
for each nName in activeworkbook.names
Set rng = Range(nName)
If Not Intersect(rng, Target) Is Nothing Then
If rng.Count = Application.CountA(rng) Then
Application.EnableEvents = False
rng.Resize(rng.Rows.Count + 1, 1).Name = nName.name
rng(rng.Count).Offset(1, 1).Resize(1, 6).FillDown
End If
End If
next nName
ErrHandler:
Application.EnableEvents = True
End Sub
Regards,
Ivan
|