Copie de doublons

Bonjour,

Je voudrais solliciter votre aide:

j'ai un fichier qui copie sur une autre feuille des lignes sans doublon. Je veux inverser la fonction : qu'elle copie les lignes correspondant aux doublons (colonne A et J) sur la feuille "services tries"

Merci pour votre aide.

bonjour

avec une matricielle et rechercheV

cordialement

Bonsoir tulipe_4, pimouslm, le forum

Ai-je bien compris

Option Explicit
Sub test()
Dim a, w(), i As Long, j As Long, dico As Object
    Set dico = CreateObject("Scripting.Dictionary")
    With Sheets("Services")
        a = .Range("j1", .Range("j" & Rows.Count).End(xlUp)).Value
        For i = 2 To UBound(a, 1)
            If Not dico.exists(a(i, 1)) Then
                ReDim w(1 To 5)
                w(1) = a(i, 1)
                dico.Item(a(i, 1)) = w
            End If
        Next
        a = .Range("a1").CurrentRegion.Value
        For i = 2 To UBound(a, 1)
            If dico.exists(a(i, 1)) Then
                w = dico.Item(a(i, 1))
                For j = 2 To UBound(a, 2)
                    w(j) = a(i, j)
                Next
                dico.Item(a(i, 1)) = w
            End If
        Next
    End With
    Application.ScreenUpdating = False
    With Sheets("Services tries").Range("a1").CurrentRegion
        With .Offset(1)
            .Clear
            .Resize(dico.Count, 5).Value = Application.Transpose(Application.Transpose(dico.items))
        End With
        .Font.Name = "calibri"
        .Font.Size = 10
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Borders(xlInsideVertical).Weight = xlThin
        .BorderAround Weight:=xlThin
        With .Rows(1)
            .Font.Size = 11
            .Interior.ColorIndex = 36
            .BorderAround Weight:=xlThin
        End With
        .Columns.AutoFit
    End With
    Set dico = Nothing
    Application.ScreenUpdating = True
End Sub

klin89

Bonsoir tulipe_4, Klin89

Merci pour vos réponses.

Klin89, Merci ta solution est tooop.