XL 2019 Insérer une ligne séléctionné dans tous les tableaux

Option Explicit

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim ad As String, choix As String, w As Worksheet
If Not IsDate("1/" & Sh.Name) Then Exit Sub
On Error Resume Next
With Target.ListObject
ad = Intersect(Target.EntireRow, Union(.Range.Rows(1), .DataBodyRange)).Address
End With
If ad = "" Then Exit Sub
Cancel = True
choix = LCase(InputBox("Entrez 'a' pour ajouter, 's' pour supprimer :", "Ajouter/Supprimer une ligne"))
If choix <> "a" And choix <> "s" Then Exit Sub
For Each w In Worksheets
If IsDate("1/" & w.Name) Then
If choix = "a" Then
w.Range(ad).Offset(1).Insert xlDown
w.Range(ad).Cells(2, 1) = "" 'force le redimensionnement du tableau
Else
w.Range(ad).Delete xlUp
End If
End If
Next
End Sub

Cliquez pour agrandir...