Sub Ajouter()
Dim nom$, lig As Variant
nom = [C5]
With Feuil3
lig = Application.Match(nom, .[B:B], 0)
If IsNumeric(lig) Then _
If MsgBox("Le nom '" & nom & "' est déjà enregistré, faut-il continuer ?", 52, "Doublon !") = 7 Then Exit Sub
lig = .[A5].CurrentRegion.Rows.Count + 5
[C4] = Application.Max(.[A:A]) + 1 'incrémente le numéro
With .Cells(lig, 1).Resize(, 7)
.Value = Application.Transpose([C4:C10]) 'transfert
.Borders.Weight = xlThin 'bordures
End With
End With
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim x$, tablo, i&, j%, n&, k%
If Intersect(Target, [E3]) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Range("G4:M" & Rows.Count).Delete xlUp 'RAZ
x = "*" & LCase([E3].Text) & "*"
If x = "**" Then Exit Sub
tablo = Feuil3.[A5].CurrentRegion.Offset(1) 'matrice, plus rapide
For i = 1 To UBound(tablo)
For j = 1 To 7
If LCase(tablo(i, j)) Like x Then
n = n + 1
For k = 1 To 7
tablo(n, k) = tablo(i, k)
Next k
Exit For
End If
Next j, i
'---restitution---
With [G4].Resize(n, 7)
.Value = tablo
.Borders.Weight = xlThin 'bordures
End With
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim r As Range, i As Variant
Set r = Intersect(Target.EntireRow, Range("G4:M" & Rows.Count))
If r Is Nothing Then Exit Sub
Cancel = True
i = Application.Match(r(1), Feuil3.[A:A], 0)
If IsNumeric(i) Then r.Copy Feuil3.Range("A" & i) 'transfert
r.Delete xlUp 'suppression de la ligne
End Sub