Salut KTM,
Salut l'équipe,
juste histoire de plonger Père Noël dans un abîme de réflexion...
Un double-clic sur la feuille démarre la macro.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tTab, iRow%, iCol1%, iCol2%
'
Cancel = True
iRow = UsedRange.Rows.Count
tTab = Range("A2:K" & iRow).Value
iCol1 = IIf(Range("A" & Rows.Count).End(xlUp).Row >= Range("G" & Rows.Count).End(xlUp).Row, 1, 7)
iCol2 = IIf(iCol1 = 1, 7, 1)
Range("A2:K" & iRow - 1).Value = ""
'
For x = 1 To UBound(tTab, 1)
For y = 1 To UBound(tTab, 1)
If tTab(x, iCol1) = tTab(y, iCol2) And CInt(tTab(x, iCol1 + 2)) = CInt(tTab(y, iCol2 + 2)) And tTab(x, iCol1 + 3) = tTab(y, iCol2 + 3) Then _
tTab(x, iCol1 + 1) = 0: _
tTab(x, iCol2 + 1) = 0
Next
Next
For x = 1 To UBound(tTab, 1)
iOK = 0
If tTab(x, iCol1 + 1) = 0 Then iOK = 1
If tTab(x, iCol2 + 1) = 0 Then iOK = IIf(iOK = 0, 3, 2)
For y = 0 To 4
tTab(x, iCol1 + y) = IIf(iOK > 0 And iOK < 3, "", tTab(x, iCol1 + y))
tTab(x, iCol2 + y) = IIf(iOK > 0, "", tTab(x, iCol2 + y))
Next
Next
Range("A2").Resize(UBound(tTab, 1), UBound(tTab, 2)).Value = tTab
Range("A1:E" & Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeBlanks).Delete shift:=xlUp
Range("G1:K" & Range("G" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeBlanks).Delete shift:=xlUp
'
End Sub
A+