Comparer 2 listes et ajouter les lignes manquantes + filtres

Bonjour à tous,

Je bute depuis ce matin sur une tâche, si vous pouvez m'aider ça m'aiderait beaucoup.

J'ai 2 feuilles dans un même fichier : la feuille ("Nouveaux travailleurs") et la feuille ("Import AM").

Sur ces 2 feuilles j'ai des colonnes identiques, les lignes de la feuille "Nouveaux travailleurs" commencent à la ligne 3, celles de la feuille "Import AM" commencent à la ligne 2.

Je souhaite comparer les données en colonne A (longueur variable) sur les 2 feuilles.

Si la donnée en colonne A de la feuille "Import" n'est pas présente dans la colonne A de la feuille "Nouveaux travailleurs" il faut copier et coller la ligne entière sur la feuille "Nouveaux travailleurs".

Ensuite je nettoie en supprimant les lignes qui ont un "0" en colonne Q ou en colonne B, en colonne O je supprime les lignes qui ont une date remontant à plus de trois mois et je la filtre du plus récent au plus ancien.

Tout se passe (à priori) bien jusqu'au point du nettoyage de la colonne O. Quand j'y regarde je vois que dans cette colonne j'ai 2 formats différents et je ne comprends pas du tout pourquoi. Mes données qui ont été copiées sont pourtant "propres".... Donc mon souci se trouve déjà sans doute dans le copier/coller.

J'ai beau m'arracher les cheveux et tenter d'autres approches, je n'y parviens pas. J'ai aussi tenté de définir le format des colonnes qui contiennent des dates mais sans succès.

Voici ma macro :

Sub MAJ_nouveaux_travailleurs()

Dim a, i As Long, dico As Object
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    a = Sheets("Import AM").Range("A2").CurrentRegion.Value
    For i = 2 To UBound(a, 1)
        dico(a(i, 1)) = Application.Index(a, i, 0)
    Next
    With Sheets("Nouveaux travailleurs")
        a = .Range("A3").CurrentRegion.Value
        For i = 3 To UBound(a, 1)
            If dico.exists(a(i, 1)) Then dico.Remove a(i, 1)
        Next
        If dico.Count > 0 Then
            With .Range("a" & .Rows.Count).End(xlUp)(2)
                With .Resize(dico.Count)
                .Offset(, 10).NumberFormat = "dd/mm/yyyy"
                .Offset(, 11).NumberFormat = "dd/mm/yyyy"
                .Offset(, 12).NumberFormat = "dd/mm/yyyy"
                .Offset(, 14).NumberFormat = "dd/mm/yyyy"
                .Offset(, 15).NumberFormat = "dd/mm/yyyy"
                .Offset(, 24).NumberFormat = "dd/mm/yyyy"
                .Offset(, 25).NumberFormat = "dd/mm/yyyy"
                .Offset(, 26).NumberFormat = "dd/mm/yyyy"
                .Offset(, 27).NumberFormat = "dd/mm/yyyy"

                End With
                If dico.Count = 1 Then
                    .Resize(1, UBound(Application.Index(dico.items, 0, 0))).Value = _
                    Application.Index(dico.items, 0, 0)
                Else
                    .Resize(dico.Count, UBound(Application.Index(dico.items, 0, 0), 2)).Value = _
                    Application.Index(dico.items, 0, 0)
                End If
            End With
        End If
    End With
    Set dico = Nothing

Dim LastRw As Long
LastRw = Sheets("Nouveaux travailleurs").Cells(Rows.Count, 1).End(xlUp).Row

    With Worksheets("Nouveaux travailleurs")
    .Range("B3:B" & LastRw).AutoFilter 1, "0"
    .AutoFilter.Range.EntireRow.Delete
    End With

    With Worksheets("Nouveaux travailleurs")
    .Range("Q3:Q" & LastRw).AutoFilter 1, "0"
    .AutoFilter.Range.EntireRow.Delete
    End With

    With Worksheets("Nouveaux travailleurs")
    .Range("O3:O" & LastRw).AutoFilter 1, "<" & Date - 90
    .AutoFilter.Range.EntireRow.Delete
    End With

    ActiveWorkbook.Worksheets("Nouveaux travailleurs").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Nouveaux travailleurs").Sort.SortFields.Add2 Key:=Range _
        ("O1:O3000"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Nouveaux travailleurs").Sort
        .SetRange Range("A3:AZ3000")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

End Sub

Vous seriez des anges si vous pouviez me dire comment me sortir de ce faux pas.

Merci.

Lorence

6tdb-forum.xlsm (300.71 Ko)

Bonjour

Depuis 20 ans (version 2003) on utilise les tableaux structurés pour les listes de données... Cela simplifie et sécurise l'usage courant et le VBA

Dans ta colonne O tu as 21 textes et non tout en date : ne pas confondre type de donnée et format de donnée.

et c'est pire dans les colonnes K, L, X et Y

Comme ces colonnes (sauf Y) sont correctes dans Import AM, c'est sans doute le code qui n'est pas bon...

Si les tableaux étaient des tableaux structurés correctement typés et formatés on pourrait copier les lignes à ajouter, ce qui serait plus simple...

On pourrait d'ailleurs utiliser une requête PowerQuery pour lister les nouveaux et basculer l'ensemble d'un coup...

Rechercher des sujets similaires à "comparer listes ajouter lignes manquantes filtres"