Déplacement de non-doublons sur une nouvelle feulle

Bonjour le forum,

Je travaille dans une structure d'accompagnement et régulièrement on me demande le nombre total heures réalisées pour les nouvelles personnes accompagnées. Pour obtenir cette information, je dois faire 2 requêtes à partir de notre base de données générales :

- Base 1 : toutes les personnes accompagnées sur l'année (dont celles ayant commencé leur accompagnement l'année précédente)

- Base 2 : toutes les personnes dont l'accompagnement a débuté sur l'année

A partir d'une macro, je voudrais comparer les 2 bases de données et supprimer sur la base 1 tous les noms n'ayant pas de doublon avec la base 2 et que ces noms soient mis sur une feuille2 (nommées : accpts antérieurs).

Je vous mets un fichier. J'espère que j'ai été claire.

Pourriez-vous m'aider à réaliser cette macro ? Je suis novice et je viens de commencer les cours VBA de Sébastien et je me sens encore perdue.

Merci de l'attention que vous porterez à ce message et pour votre aide.

Bonne soirée,

Isabelle

Bonjour et bienvenue sur le forum

Essaie ce code :

Dim plage As Range, Ln As Integer, cell As Range

Sub Suppression()

    Set plage = Range("F3:F" & Range("F" & Rows.Count).End(xlUp).Row)
    For Ln = Range("A" & Rows.Count).End(xlUp).Row To 3 Step -1
        Set cell = plage.Find(Cells(Ln, "A").Value, lookat:=xlWhole)
        If cell Is Nothing Then
            Range("A" & Ln & ":D" & Ln).Delete Shift:=xlUp
        End If
    Next Ln
End Sub

Te convient-il ?

Bye !

Bonsoir Isabelle, Gmb. bonsoir le forum,

Une autre proposition avec un code bien plus long que celui de Gmb mais, je pense, plus rapide d'exécution :

Sub Macro1()
Dim BS As Object 'déclare la variable BS (onglet BaseS)
Dim AA As Object 'déclare la variable AA (onglet Accpts Antérieurs)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim TC1 As Variant 'déclare la variable TC1 (Tableau de Cellules 1)
Dim TC2 As Variant 'déclare la variable TC2 (Tableau de Cellules 2)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim K As Byte 'déclare la variable K (incrément)
Dim PL As Range 'déclare la variable PL (PLage)

Set BS = Sheets("Feuil1") 'définit l'onglet BS (à adapter)
Set AA = Sheets("accpts antérieurs") 'définit l'onglet AA
DL = BS.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne 1 (=A) de l'onglet BS
TC1 = BS.Range("A3:D" & DL) 'définit le tableau de cellule TC1
DL = BS.Cells(Application.Rows.Count, 6).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne 6 (=F) de l'onglet BS
TC2 = BS.Range("F3:I" & DL) 'définit le tableau de cellule TC2
Set PL = BS.Range("A1") 'définit la plage PL (initialise)
For I = 1 To UBound(TC1, 1) 'boucles 1 : sur toutes les lignes du tableau TC1
    For J = 1 To UBound(TC2, 1) 'boucles 2 : sur toutes les lignes du tableau TC2
        'si le nom/prénom de la ligne de TC1 et égal au nom/prénom de la ligne de TC2, va à l'étiquette "suite"
        If TC1(I, 1) & TC1(I, 2) = TC2(J, 1) & TC2(J, 2) Then GoTo suite
    Next J 'prochaine ligne de la boucle 2
    'définit la cellule de destination DEST (A1 si A1 est vide, sinon la première ligne vide de la colonne 1 (=A) de l'onglet AA)
    Set DEST = IIf(AA.Range("A1").Value = "", AA.Range("A1"), AA.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0))
    For K = 1 To UBound(TC1, 2) 'boucle 3 : sur toutes les colonnes du tableau TC1
        DEST.Offset(0, K - 1).Value = TC1(I, K) 'renvoie les valeurs de la ligne de TC1 non trouvée dans TC2
    Next K 'prochaine colonne de la boucle 3
    'définit la plage PL
    Set PL = IIf(PL.Cells.Count = 1, BS.Cells(I + 2, 1).Resize(, 4), Application.Union(PL, BS.Cells(I + 2, 1).Resize(, 4)))
suite: 'étiquette
Next I 'prochaine ligne de la boucle 1
PL.Delete shift:=xlUp 'supprime les lignes de la plage PL
End Sub

Le fichier :

Bonsoir Gmb et Thauthème,

C'est super !! Je vous remercie pour votre aide et votre rapidité de réponse. Les deux macros sont biens mais celle de Thauthème me convient mieux. Avec la seconde feuille (accpts antérieurs) je peux, en effet, vérifier l'exactitude de mes requêtes avec mon logiciel de base de données.

Merci encore pour votre aide,

Bonne soirée,

Isabelle