Probleme pour personaliser un code qui copie des cellules

Sub Zonecombinée1_QuandChangement()
Dim i% 'déclaration d'un "compteur" de type Integer
Dim c As Range 'déclaration d'une variable de type "cellule" ou "plage de cellules"
Sheets("extraction").Range("D8:H5000").Clear 'effacer contenu et mise en forme de la plage
i = 1 'initialisation du compteur

'pour chaque cellule de la plage de A2 à ... la dernière cellule non-vide de la colonne A de la feuille BASE
For Each c In Sheets("BASE").Range("A2:A" & Sheets("BASE").Range("A65000").End(xlUp).Row)
    'si le contenu (en majuscules) de chaque cellule = le contenu (en majuscules) de la cellule D1 de la feuille EXTRACTION
    If UCase(c) = UCase(Sheets("extraction").Range("D1")) Then
        'étendre la "sélection" de la cellule en cours et ses 4 voisines de droite, dans la même ligne
        'copier ces 5 cellules, puis les coller dans la feuille EXTRACTION, en colonne D, dans la ligne
        'dont le n° correspond à la valeur du compteur (en ajoutant les 6 lignes vides, + la ligne de titre)
        c.Resize(, 5).Copy Destination:=Sheets("extraction").Range("D" & i + 7)
        'incrémenter le compteur de lignes
        i = i + 1
    End If
Next c 'passer à la cellule suivante dans la colonne A de la feuille BASE
End Sub