VBA rij invoegen met behoud van formules , validatie, opmaak e.d.

=IF(C3="";"";TEXT(DATE(YEAR(C3);MONTH(C3);DAY(C3));"MMM"))

=TEXT(C3;"mmm")

mmm;;

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

     On Error Resume Next
     Set tbl = Target.ListObject                                'tabel van de cel waarin je dubbelklikt
     On Error GoTo 0
     If tbl Is Nothing Then MsgBox "je staat niet in een tabel", vbCritical: Exit Sub

     r = Target.Row - tbl.HeaderRowRange.Row                    'hoeveelste tabelrij ?
     If r <= 1 Then MsgBox "foutje, niet koprij of 1e rij", vbCritical: Exit Sub
     Set c = Intersect(Target.Offset(-1).EntireRow, tbl.DataBodyRange)     'bereik van de listrij er juist boven, dus daarvan de dag meenemen
     tbl.ListRows.Add r                                         'listrij invoegen
     c.Cells(2, 3).Value = c.Cells(1, 3).Value                  'dag invullen
     Cancel = True
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Row = 3 Then Cancel = True
If Not Intersect(Target, Range("Tabel1")) Is Nothing And Target.Row > 3 Then
    ActiveCell.Insert    [COLOR="#008000"] 'code ooit van @HSV gekregen[/COLOR]
    Cancel = True
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count = 1 And Not IsEmpty(Target) Then
    If Not Intersect(Target, Range("Tabel1[Afd]")) Is Nothing Then
        
         i = ActiveCell.Row - 1
        If i <> 1 Then
             ListObjects(1).ListRows.Add (i)
        Else
             ListObjects(1).ListRows.Add (2)
        End If
    End If
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
With ListObjects(1)
 If Not Intersect(Target, .ListColumns(5).Range.Resize(, 2)) Is Nothing Then
   Application.EnableEvents = False
    .ListRows.Add Target.Row - .HeaderRowRange.Row + 1
   Application.EnableEvents = True
 End If
End With
End Sub