copier coller dans une autre feuille sans doublons ni vides

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

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