Insert Rows Automatically...

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Me.Columns(8)) Is Nothing Then
        If Target.Cells.Count = 1 Then
            If Target.Value <> "" Then
                Me.Rows(Target.Row + 1).Insert
                Me.Cells(Target.Row+1,1).Activate
            End If
        End If
    End If

End Sub

Please refrain from quoting whole posts - it clutters the forum (see rule 12). I can easily look at the previous post to see what was last written.