Bonjour
Merci des infos. Là il y a pas mal de données à traiter éventuellement. Faites ceci :
1. Dans le code Private Sub Worksheet_SelectionChange(ByVal Target As Range) qui se trouve dans les feuilles ENTREE et STOCK, ajoutez cette ligne
If Target.Count > 1 Then Exit Sub
2. Dans le module 1, remplacez la macro Supprimer que je vous avais donnée par celle ci-dessous
'//BOUTON SUPPRIMER LIGNE DU TABLEAU SELECTIONNE
Sub supprimer_ligne()
Dim Code As String
Dim lo As ListObject, lr As ListRow, lRowInTable As Long
If Not ActiveCell.ListObject Is Nothing Then
msg = "Supprimer cette ligne " & ActiveCell.Row & "?"
Style = vbYesNo + vbCritical + vbDefaultButton2
Title = "Suppression"
Response = MsgBox(msg, Style, Title)
If Response = vbYes Then
Set lo = ActiveCell.ListObject
lRowInTable = ActiveCell.Row - lo.HeaderRowRange.Row
Code = lo.DataBodyRange.Item(lRowInTable, 7)
Set lr = lo.ListRows(lRowInTable)
lr.Range.Delete
Dim c As Range, Rng As Range
Dim firstaddress As String
Dim lig As Long
Dim Feuille
Dim i As Byte, j As Byte
Feuille = Array(Feuil3, Feuil5)
For i = 0 To UBound(Feuille)
With Feuille(i).ListObjects("TAB" & Feuille(i).Name)
Feuille(i).Unprotect PSW
Set c = .DataBodyRange.Find(Code, LookIn:=xlValues)
If Not c Is Nothing Then
firstaddress = c.Address
Do
lig = Range(c.Address).Row - 16
.ListRows(lig).Range.ClearContents
j = j + 1
Set c = .DataBodyRange.FindNext(c)
On Error Resume Next
Loop While Not c Is Nothing And c.Address <> firstaddress '--> Dan
Set Rng = .DataBodyRange.SpecialCells(xlCellTypeBlanks)
If j = 1 Then
.ListRows(lig).Range.Delete: j = 0
Else: Rng.Delete
End If
End If
Feuille(i).Protect PSW
End With
Next i
End If
End If
Cordialement