Microsoft 365 Ajouter une ligne pour deux tableaux structurés l'un à côté de l'autre

Option Explicit

Sub Insert_Row() 'Insert a row in active sheet
  Dim Cell As Range, msg$, lig&: lig = ActiveCell.Row
  If ActiveSheet.Name = "BUDGET_FORCAST" And lig <= 8 Then 'emplacement erroné
    Select Case [HOME_PAGE!F1]
      Case "EN": msg = "You can't insert a row at this location"
      Case "FR": msg = "Vous ne pouvez pas insérer une ligne à cet emplacement"
      Case "ES": msg = "No puedes insertar una línea en este lugar"
    End Select
    MsgBox msg, 64, "Project Tracker :": Exit Sub
  End If
  On Error Resume Next 'Insertion d'une ligne sur la feuille active
  ActiveSheet.Unprotect "test": Application.Calculation = -4135: Application.EnableEvents = 0
  With ActiveCell
    .EntireRow.Insert 4: .Offset(-1).EntireRow.Copy Cells(.Row, 1)
    .EntireRow.SpecialCells(2, xlNumbers + xlTextValues + xlLogical + xlErrors).ClearContents
    .Activate
  End With
  Application.EnableEvents = -1: Application.Calculation = -4105: ActiveSheet.Protect "test"
End Sub

Sub Delete_Row() 'Erase a row in active sheet
  Dim Cell As Range, msg$
  Select Case [HOME_PAGE!F1] 'Message de confirmation & suppression
    Case "EN": msg = "Do you really want to erase this row ?"
    Case "FR": msg = "Voulez-vous vraiment supprimer cette ligne ?"
    Case "ES": msg = "¿Realmente quieres borrar esa línea?"
  End Select
  If MsgBox(msg, 4, "Confirmation") <> 6 Then Exit Sub
  ActiveSheet.Unprotect "test": Application.Calculation = -4135: Application.EnableEvents = 0
  Rows(ActiveCell.Row).Delete
  Application.EnableEvents = -1: Application.Calculation = -4105: ActiveSheet.Protect "test"
End Sub

Option Explicit

Const T1$ = "Tableau1" 'Nom du Tableau n° 1
Const T2$ = "Tableau2" 'Nom du Tableau n° 2

Sub Insert_Row() 'Insert a row in active sheet
  Dim Tbl$, msg$, dlg&, lig&, col%: lig = ActiveCell.Row
  If ActiveSheet.Name = "BUDGET_FORCAST" And lig < 9 Then 'emplacement erroné
    Select Case [HOME_PAGE!F1]
      Case "EN": msg = "You can't insert a row at this location"
      Case "FR": msg = "Vous ne pouvez pas insérer une ligne à cet emplacement"
      Case "ES": msg = "No puedes insertar una línea en este lugar"
    End Select
    MsgBox msg, 64, "Project Tracker :": Exit Sub
  End If
  ActiveSheet.Unprotect "test": Application.Calculation = -4135: Application.EnableEvents = 0
  col = ActiveCell.Column: If col < 6 Then Tbl = T1 Else Tbl = T2
  With ActiveSheet.ListObjects(Tbl)
    dlg = .ListRows.Count: If lig <= dlg + 8 Then .ListRows.Add lig - 8
  End With
  Application.EnableEvents = -1: Application.Calculation = -4105: ActiveSheet.Protect "test"
End Sub

Sub Delete_Row() 'Erase a row in active sheet
  Dim Tbl$, msg$, dlg&, lig&, col%: lig = ActiveCell.Row
  Select Case [HOME_PAGE!F1] 'Message de confirmation & suppression
    Case "EN": msg = "Do you really want to erase this row ?"
    Case "FR": msg = "Voulez-vous vraiment supprimer cette ligne ?"
    Case "ES": msg = "¿Realmente quieres borrar esa línea?"
  End Select
  If MsgBox(msg, 4, "Confirmation") <> 6 Then Exit Sub
  ActiveSheet.Unprotect "test": Application.Calculation = -4135: Application.EnableEvents = 0
  col = ActiveCell.Column: If col < 6 Then Tbl = T1 Else Tbl = T2
  With ActiveSheet.ListObjects(Tbl)
    dlg = .ListRows.Count: If lig <= dlg + 8 Then .ListRows(lig - 8).Delete
  End With
  Application.EnableEvents = -1: Application.Calculation = -4105: ActiveSheet.Protect "test"
End Sub