Tableau

Option Explicit

Sub Isole()
Dim Lig&, DerL&, C_Lig&
DerL = Feuil1.Range("E" & Rows.Count).End(3).Row

C_Lig = 1
With Feuil1
Range("D3:D" & DerL).FormulaR1C1 = "=IF(RC[1]="""",1,COUNTIF(R3C1:R200C1,RC[1]))"
For Lig = DerL To 3 Step -1
If Cells(Lig, "D") = 0 Then
Range("E" & Lig & ":G" & Lig).Cut Feuil2.Range("A" & C_Lig)
C_Lig = C_Lig + 1
End If
Next
End With
Columns("D:D").Clear
End Sub

Private Sub Worksheet_Activate()
Dim P As Range, a$
Application.ScreenUpdating = False
Feuil1.[A:G].Copy [A1] 'Feuil1 est le CodeName de la feuille source
Set P = Me.UsedRange.Offset(2) 'décalage à cause des 2 lignes de titres
'---colonne D pour Tableau A---
With P.Columns(4)
  a = P.Columns(6).Address(ReferenceStyle:=xlR1C1)
  .FormulaR1C1 = "=1/IF(RC2<>"""",COUNTIF(" & a & ",RC2)=0)"
  .Value = .Value 'supprime les formules
  Range("A3", .Cells).Sort .Cells, xlAscending, Header:=xlNo 'tri pour accélérer
End With
'---colonne H pour Tableau B---
With P.Columns(8)
  a = P.Columns(2).Address(ReferenceStyle:=xlR1C1)
  .FormulaR1C1 = "=1/IF(RC6<>"""",COUNTIF(" & a & ",RC6)=0)"
  .Value = .Value 'supprime les formules
  Range("E3", .Cells).Sort .Cells, xlAscending, Header:=xlNo 'tri pour accélérer
End With
'---supprime les valeurs d'erreur (doublons et cellules vides)---
'On Error Resume Next 'inutile puisqu'avec le décalage il y a des cellules vides
Intersect([A:D], [D:D].SpecialCells(xlCellTypeConstants, 16).EntireRow).Delete xlUp
Intersect([E:H], [H:H].SpecialCells(xlCellTypeConstants, 16).EntireRow).Delete xlUp
[D:D,H:H].ClearContents
Set P = Me.UsedRange 'actualise la barre de défilement verticale
End Sub

Private Sub Worksheet_Activate()
Dim P As Range, a$
Application.ScreenUpdating = False
Feuil1.[A:G].Copy [A1] 'Feuil1 est le CodeName de la feuille source
Set P = Me.UsedRange.Offset(2) 'décalage à cause des 2 lignes de titres
'---colonne D pour Tableau A, colonne H pour Tableau B---
For Each P In Union(P.Columns(4), P.Columns(8)).Areas
  a = P.Offset(, IIf(P.Column = 4, 2, -6)).Address(ReferenceStyle:=xlR1C1)
  P.FormulaR1C1 = "=1/IF(RC[-2]<>"""",COUNTIF(" & a & ",RC[-2])=0)"
  P = P.Value 'supprime les formules
  Range(P.Offset(, -3), P).Sort P, xlAscending, Header:=xlNo 'tri pour accélérer
Next
'---supprime les valeurs d'erreur (doublons et cellules vides)---
'On Error Resume Next 'inutile puisqu'avec le décalage il y a des cellules vides
Intersect([A:D], [D:D].SpecialCells(xlCellTypeConstants, 16).EntireRow).Delete xlUp
Intersect([E:H], [H:H].SpecialCells(xlCellTypeConstants, 16).EntireRow).Delete xlUp
[D:D,H:H].ClearContents
Set P = Me.UsedRange 'actualise la barre de défilement verticale
End Sub

Private Sub Worksheet_Activate()
Dim P As Range, a$
Application.ScreenUpdating = False
Feuil1.[A:G].Copy [A1] 'Feuil1 est le CodeName de la feuille source
Set P = Me.UsedRange.Offset(2) 'décalage à cause des 2 lignes de titres
'---colonne D pour Tableau A, colonne H pour Tableau B---
For Each P In Union(P.Columns(4), P.Columns(8)).Areas
  a = P.Offset(, IIf(P.Column = 4, 1, -7)).Address(ReferenceStyle:=xlR1C1)
  P.FormulaR1C1 = "=1/IF(RC[-3]<>"""",COUNTIF(" & a & ",RC[-3])=0)"
  P = P.Value 'supprime les formules
  Range(P.Offset(, -3), P).Sort P, xlAscending, Header:=xlNo 'tri pour accélérer
Next
'---supprime les valeurs d'erreur (doublons et cellules vides)---
'On Error Resume Next 'inutile puisqu'avec le décalage il y a des cellules vides
Intersect([A:D], [D:D].SpecialCells(xlCellTypeConstants, 16).EntireRow).Delete xlUp
Intersect([E:H], [H:H].SpecialCells(xlCellTypeConstants, 16).EntireRow).Delete xlUp
[D:D,H:H].ClearContents
Set P = Me.UsedRange 'actualise la barre de défilement verticale
End Sub