copier coller dans une autre feuille sans doublons ni vides

[webmuster]

Bonjour à tous

Après bien des recherches, je sollicite votre aide.

Mon classeur compte plusieurs feuilles, avec dans chacune, une liste variable de données en colonne A (à partir de la cellule A3).
Je souhaite copier simultanément les données de toutes ces listes, et les compiler dans une autre feuille (recap), en colonne B (cellule B3), sans doublons ni vides.

Je suis parti de cette formule qui colle les données dans la même feuille:

Range("A3:A" & [A65000].End(xlUp).Row).SpecialCells(xlCellTypeConstants, 23).Copy Cells(Rows.Count, 2).End(xlUp)(2)

Je vous laisse un petit fichier de demo.

Cordialement

 

[Guest]

Re : copier coller dans une autre feuille sans doublons ni vides

Bonjour,

Proposition par filtrage avancé :

Sub recap()
Dim sh As Worksheet
For Each sh In ThisWorkbook.Worksheets
    If sh.Name <> "recap" Then
        
        sh.Range("A3:A" & [A65000].End(xlUp).Row).AdvancedFilter _
                Action:=xlFilterCopy, _
                CopyTorange:=Sheets("recap").Range("B" & Rows.Count).End(xlUp).Offset(1), _
                unique:=True
    End If
Next
'nettoyage des vides
On Error Resume Next
With Sheets("recap")
    .Range("B3:B" & .Range("B" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeBlanks).Delete
End With
End Sub

A+

 

[pierrejean]

Re : copier coller dans une autre feuille sans doublons ni vides

Bonjour webmuster

Teste:

Sub recap()
Set d = CreateObject("Scripting.dictionary")
For Each sh In Sheets
If sh.Name <> "recap" Then
  For n = 3 To sh.Range("A" & Rows.Count).End(xlUp).Row
    x = sh.Range("A" & n)
    If x <> "" Then d(x) = x
  Next
End If
Next
Range("B3").Resize(d.Count) = Application.Transpose(d.keys)
End Sub

Edit: Salut JB

 

[webmuster]

Re : copier coller dans une autre feuille sans doublons ni vides

Merci à vous deux pour votre disponibilité et votre générosité.

Pierrejean, ta solution me convient parfaitement.

Cordialement