Sub Doublons()
Dim nbtab&, prem As Range, deb As Range, colrest#, i&, col#, P As Range, j, k
nbtab = 9 'nombre maximum de tableaux
Set prem = [B6] '1ère cellule avec la valeur 1, à adapter
Set deb = prem
colrest = 6 'n° de colonne de restitution par rapport à deb
Application.ScreenUpdating = False
For i = 1 To nbtab
deb(1, colrest).Resize(2, 6).Clear 'RAZ de la zone de restitution
col = colrest
Set P = deb(1, 2).Resize(6, 2) '1ère zone de recherche
For j = 1 To 6
For k = 1 To 2
If Application.CountIf(P, P(j, k)) > 1 Then
If Application.CountIf(deb(1, colrest).Resize(, 6), P(j, k)) = 0 Then
P(j, k).Copy deb(1, col)
col = col + 1
End If
End If
Next k
Next j
col = colrest
Set P = deb(12, 2).Resize(6, 2) '2ème zone de recherche
For j = 6 To 1 Step -1
For k = 1 To 2
If Application.CountIf(P, P(j, k)) > 1 Then
If Application.CountIf(deb(2, colrest).Resize(, 6), P(j, k)) = 0 Then
P(j, k).Copy deb(2, col)
col = col + 1
End If
End If
Next k
Next j
Set deb = deb.EntireColumn.Find(1, deb, xlValues, xlWhole) 'recherche du 1
If deb.Row = prem.Row Then Exit For
Next i
End Sub