Option Explicit
Const Ccol% = 10
Sub LaunchKeep()
Dim n$(1 To 2), b%, i%, j%
For i = 1 To 2
b = False
n(i) = Application.InputBox("Nom de la feuille numéro " & i & " ?")
For j = 1 To Worksheets.Count
If Worksheets(j).Name = n(i) Then
b = True
Exit For
End If
Next j
If b = False Then
MsgBox "Feuille non trouvée"
Exit Sub
End If
Next i
Call Keep1(n, False)
End Sub
Sub Keep1(n$(), Sup%)
Dim Ws(1 To 2) As Worksheet, r&(1 To 3), tb(), i&, j%, c%, k%, Sy As Worksheet
For i = 1 To 2
Set Ws(i) = Worksheets(n(i))
Next i
Sheets.Add
Set Sy = ActiveSheet
For i = 1 To 2
r(i) = Ws(i).Cells(Rows.Count, 1).End(xlUp).Row
Next i
ReDim tb(2 To r(1) + r(2) - 1, 1 To Ccol + 1)
For i = LBound(tb) To UBound(tb)
For j = 1 To Ccol
If i < r(1) + 1 Then
tb(i, j) = Ws(1).Cells(i, j)
Else
tb(i, j) = Ws(2).Cells(i - r(1) + 1, j)
End If
Next j
tb(i, Ccol + 1) = True
Next i
For i = LBound(tb) To r(1)
For j = r(1) + 1 To UBound(tb)
c = 0
For k = 1 To Ccol
If tb(i, k) = tb(j, k) Then
c = c + 1
End If
If c = Ccol Then
tb(i, Ccol + 1) = False
tb(j, Ccol + 1) = False
End If
Next k
Next j
Next i
r(3) = 1
For i = LBound(tb) To UBound(tb)
If tb(i, Ccol + 1) = True Then
r(3) = r(3) + 1
For j = 1 To Ccol
Sy.Cells(r(3), j) = tb(i, j)
Next j
End If
Next i
Ws(1).Range(Ws(1).Cells(1, 1), Ws(1).Cells(1, Ccol)).Copy _
Destination:=Sy.Cells(1, 1)
Sy.Columns.AutoFit
If Sup = True Then
Application.DisplayAlerts = False
For i = 1 To 2
Ws(i).Delete
Next i
Application.DisplayAlerts = True
End If
End Sub