Private Sub Worksheet_Change(ByVal Target As Range) 'au changement dans l'onglet
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim PL As Range 'déclare la variable PL (PLage)
Dim PLV As Long 'déclare la variable PLV (Première Ligne Vide)
Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
If Target.Address <> "$A$1" Then Exit Sub 'si le changement a lieu ailleurs qu'en A1, sort de la procédure
If Target = "" Then Exit Sub 'si A1 est effacée, sort de la procédure
'si "Non" au message, sort de la procédure
If MsgBox("Êtes-vous sûr(e) de vouloir archiver le foyer " & Target.Value & " ?", vbYesNo, "ATTENTION") = vbNo Then Exit Sub
Set PL = Range("A1") 'initialise la plage PL
Set OD = Worksheets("archive") 'définit l'onglet destination OD
TV = Range("A3").CurrentRegion 'définit le tableau des valeurs TV
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
If TV(I, 2) = Target.Value Then 'condition : si la donnée ligne I colonne 2 (le foyer) est égale à la valeur de la cellule A1
'redéfinit la plage PL (la ligne (I+2) si PL ne contient qu'une seule cellule, sinon l'union de la plage PL et de la ligne (I+2))
Set PL = IIf(PL.Cells.Count = 1, Rows(I + 2), Application.Union(PL, Rows(I + 2)))
End If 'fin de la condition
Next I 'prochaine ligne de la boucle
PLV = OD.Cells(Application.Rows.Count, "A").End(xlUp).Row + 1 'de'finit la première ligne vide PLV de la colonne A de l'ongelt OD
PL.Copy OD.Cells(PLV, 1) 'copie la plage PL et la colle dans la cellule ligne PLV colonne 1 de l'onget OD
PL.Delete shift:=xlShiftUp 'supprime la plage PL
OD.Activate 'active l'onglet OD (ligne à supprimer éventuellement)
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub