MACRO Fusion de tableaux et suppression de doublon

[GABANA]

Bonjour à tous,

Je suis nouvelle sur ce site et novice dans le monde des macro excel.
Après de nombreuses recherches, j'ai réussi à faire une macro mais elle ne fonctionne pas comme je le voudrais.
Dans mon fichier excel, j'ai :
feuillet 1: "2017" j'ai un fichier sur lequel des annotations ont été apportées
Feuillet 2 : "REPORTING AWS"
Feuillet " : 2017RECAP
Sur ce dernier feuillet 2017 RECAP, je veux fusionner les tableaux des 2 autres feuillets en supprimant les doublons issus du feuillet "REPORTING AWS"
Je vous joins mon fichier excel dans lequel j'ai créer une macro qui fonctionne à moitié.
Est ce que quelqu'un peut m'aider svp ?
Je tourne en rond sur ce problème depuis 2 jours :-(
Mille merci

 

[cp4]

Bonjour et bienvenue sur XLD,

Je ne suis pas sûr d'avoir compris tes attentes. Mais voici un essai.

Sub Fusion()
    Application.ScreenUpdating = False
    Sheets("2017RECAP").Cells.Clear

    dl2 = Sheets("2017").Range("AP" & Rows.Count).End(xlUp).Row

    With Sheets("REPORTING_AWS")
        .Range("A1:AP" & .Range("AP" & Rows.Count).End(xlUp).Row).Copy Sheets("2017RECAP").[A1]
    End With
    With Sheets("2017RECAP")
        dl1 = .Range("AP" & .Rows.Count).End(xlUp).Row
        For i = 2 To dl2
            For j = 2 To dl1
                If Sheets("2017").Range("AP" & i).Value <> .Range("AP" & j).Value Then
                    Sheets("2017").Range("A" & i & ":AP" & i).Copy Sheets("2017RECAP").Range("A" & dl1 + 1)
                End If
            Next j
        Next i
    End With
Application.ScreenUpdating = True
End Sub

 

[gosselien]

Bonjour,

une tentative perfectible niveau doublon

Sub Fusion()
Application.ScreenUpdating = False
Dim Recap As Worksheet
Set Recap = Sheets("2017recap")
Sheets("2017RECAP").Cells.ClearContents
Sheets("REPORTING_AWS").[A1].CurrentRegion.Copy Destination:=Recap.[A1]
Set desti = [Recap].[B65000].End(xlUp)
Sheets("2017").[A1].CurrentRegion.Copy Destination:=desti(1, 0)
' suppression des doublons
Recap.Select
[AP1].Sort Key1:=[AP2], Order1:=xlAscending, Header:=xlYes
ActiveSheet.Range("$A$2:$AP$60000").RemoveDuplicates Columns:=42, Header:=xlYes
Application.ScreenUpdating = True
End Sub