Faire appel à un autre classeur et supprimer les doublons

Bonjour à tous,

Petite explication de ma tentative de code

J'ai un fichier excel sur lequel j'utilise des données d'un autre fichier excel qui est mis à jour régulièrement par quelqu'un d'autre.

Ainsi je souhaite récupérer les données de ce fichier (colonnes A à F du fichier d'origine) et les copier/coller en concatenant les colonnes A à E sur une colonne qui represente la "designation du document" (A par exemple) et la colonne F en B qui représente la "révision du document"

Aussi la personne qui traite les données depuis sont fichier excel rajoute des lignes de document avec des "revisions" différentes, je souhaite conserver seulement la plus récente donc avec l'indice de révision le plus élevé

Avec ce code, je procède en 3 étapes, j'importe colonne par colonne, je concatène, je supprime les doublons et je garde la plus grande révision et enfin je supprime les colonnes inutiles.

Seulement d'une part le fichier est trop lourd je souhaiterai faire toutes les opérations en même temps sans avoir à supprimer les colonnes inutiles (puisqu'il n'y en aurait pas). Et lorsque j'importe les valeurs du fichier d'origine les 0 de gauches sont supprimés hors ils sont important pour la "désignation du document"

Aussi le classeur d'origine ne souvre pas tout seul (l'explorateur windows s'ouvre et je selectionne le fichier)

Ci-dessous le "code"

Merci d'avance les petits génies

Option base 1
Sub COPIEDONNEES()
Dim NomFichierEntree
Dim Sortie As Workbook
Dim Entree As Workbook
Dim FeuilleOrigine As Worksheet
Dim FeuilleDestination As Worksheet
Dim cell As Range, derlig As Long
Dim i As Long

    Set Sortie = ThisWorkbook
    'Choisir fichier
    NomFichierEntree = Application.GetOpenFilename("Fichier Excel (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm")
    ' On verifie que l'on a selectionné un nom de classeur
    If NomFichierEntree <> False Then
        ' On ouvre le classeur
        Set Entree = Workbooks.Open("C:\Users\ndjemel\Documents\NM 101503120020001_A.xls")

        'Référence feuille origine des données à copier
        Set FeuilleOrigine = Entree.Sheets("Cat.  métho. GL1943")

        'Référence la feuille de destination des cellules copiées
        Set FeuilleDestination = Sortie.Sheets("Feuil1")

        ' On copie les cellules de la feuille désirée vers la feuille de sortie
        FeuilleDestination.Range("C9:C" & FeuilleOrigine.Range("A65536").End(xlUp).Row).Value = FeuilleOrigine.Range("A9:A" & FeuilleOrigine.Range("A65536").End(xlUp).Row).Value
        FeuilleDestination.Range("D9:D" & FeuilleOrigine.Range("A65536").End(xlUp).Row).Value = FeuilleOrigine.Range("B9:B" & FeuilleOrigine.Range("A65536").End(xlUp).Row).Value
        FeuilleDestination.Range("E9:E" & FeuilleOrigine.Range("A65536").End(xlUp).Row).Value = FeuilleOrigine.Range("C9:C" & FeuilleOrigine.Range("A65536").End(xlUp).Row).Value
        FeuilleDestination.Range("F9:F" & FeuilleOrigine.Range("A65536").End(xlUp).Row).Value = FeuilleOrigine.Range("D9:D" & FeuilleOrigine.Range("A65536").End(xlUp).Row).Value
        FeuilleDestination.Range("G9:G" & FeuilleOrigine.Range("A65536").End(xlUp).Row).Value = FeuilleOrigine.Range("E9:E" & FeuilleOrigine.Range("A65536").End(xlUp).Row).Value
        FeuilleDestination.Range("B9:B" & FeuilleOrigine.Range("A65536").End(xlUp).Row).Value = FeuilleOrigine.Range("F9:F" & FeuilleOrigine.Range("A65536").End(xlUp).Row).Value
        Entree.Close

    ' On concatene les cellules
    derlig = Split(Worksheets("Feuil1").UsedRange.Address, "$")(4)

    For Each cell In Range("A1:A" & derlig)
            cell = ""
            Cells(cell.Row, 1) = Cells(cell.Row, 3) & Cells(cell.Row, 4) & Cells(cell.Row, 5) & Cells(cell.Row, 6) & Cells(cell.Row, 7)
            Cells(cell.Row, 1) = RTrim(Cells(cell.Row, 1))
    Next
    ' On supprime les doublons et on conserve la plus grand revision
    With Feuil1
        For i = 2 To .Range("A" & Rows.Count).End(xlUp).Row
            If .Cells(i, 1) = .Cells(i + 1, 1) And .Cells(i, 1) <> "" Then
                If .Cells(i, 2) > .Cells(i + 1, 2) Then
                    .Cells(i + 1, 1).EntireRow.Delete
                    i = i - 1
                Else
                    .Cells(i, 1).EntireRow.Delete
                    i = i - 1
                End If
            End If
        Next i
    Range("C:G").Delete Shift:=xlToLeft
    End With

        End If
        End Sub