VBA sql select sans supprimer doublon

Bonjour à tous

Je demande votre aide afin de trouver solution à un problème qui m'embête depuis quelques jours.

En fait, j'ai une liste ou plusieurs listes à partir des desquels je souhaite faire un select sur les données et coller dans une autre feuille. J'utilise le code ci dessous, tout semble aller comma sur des rails, sauf que à regarder de plus près, lors de la sélection les doublons de la première colonne sont supprimés.

Je souhaiterais garder les doublons sans qu'ils ne soient supprimés, et c'est la que je bloque, je ne sais pas quel erreur j'ai commis et quel est la solution.

J'ai besoin de votre aide.

Le code :

Sub LoadL()
    'Declaration des variables
    Dim model As Variant, comp As String, neuf As String

    'Preparation requette
    strSQL = "SELECT [Liste$A3:T].[Ref], [Liste$A3:T].[Label], [Liste$A3:T].[QTE], 0, IIF([Liste$A3:T].[Niveau11] = 'Sys', 1, 0) as Percent1, 0 FROM [Liste$A3:T] UNION SELECT [Liste$A3:T].[Ref], [Liste$A3:T].[Label], [Liste$A3:T].[QTE], 0, IIF([Liste$A3:T].[Niveau11] = 'Sys', 1, 0) as Percent1, 0 FROM [Liste$A3:T]" _
    & "UNION SELECT [Liste$A3:T].[Ref], [Liste$A3:T].[Label], [Liste$A3:T].[QTE], 0, IIF([Liste$A3:T].[Niveau11] = 'Sys', 1, 0) as Percent1, 0 FROM [Liste$A3:T]"

    closeRS

    OpenDB

    rs.Open strSQL, cnn, adOpenKeyset, adLockOptimistic
    If rs.RecordCount > 0 Then
        pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).CopyFromRecordset rs
    Else
        MsgBox "Error.", vbExclamation + vbOKOnly
        Exit Sub
    End If
End Sub

Merci d'avance

Cordialement

Bonjour,

https://www.excel-downloads.com/threads/vba-sql-select-sans-supprimer-doublon.20062258/post-20470098