Bonjour,
Une piste :
Sub Doublons()
Dim Tbl() As String
Dim PlgPartenaire As Range
Dim PlgEntreprise As Range
Dim Cel As Range
Dim CelTrouve As Range
Dim I As Long
With Worksheets("Partenaire"): Set PlgPartenaire = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With
With Worksheets("entreprise"): Set PlgEntreprise = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With
For Each Cel In PlgPartenaire
Set CelTrouve = PlgEntreprise.Find(Cel.Value, , xlValues, xlWhole)
If Not CelTrouve Is Nothing Then
I = I + 1: ReDim Preserve Tbl(1 To I)
Tbl(I) = Format(Cel.Value, "00000000000")
End If
Next Cel
With Worksheets("Analyse"): .Range(.Cells(1, 1), .Cells(UBound(Tbl), 1)).Value = Application.Transpose(Tbl): End With
End Sub