Modifier choix liste déroulante vba

Sub Macro1()
'
' Macro1 Macro
    'derniere cellule non vide liste pour liset de choix
    derlig = Worksheets("feuil1").Range("A" & Rows.Count).End(xlUp).Row
    For x = 1 To derlig
        With Worksheets("feuil1")
            'ecriture dans cellule liste de choix
            .Range("D2") = .Range("A" & x)
            'attente fin calcul (si beaucoup de formules)
            .Calculate
            'selection onglet
            .Cells.Select
            Selection.Copy
            'nouveau classeur
            Workbooks.Add
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            ActiveWorkbook.Close
        End With
    Next x
End Sub