如何在VBA中为每个excel文件的某些列创建下拉列表？

Question

我尝试在每个excel文件的某些列中创建一个下拉列表 之后，我需要将这些更改保存在Excel文件中。

Sub convert_xls_TO_xlsx()

        Dim fName       As String
        Dim MyFolder    As String

        MyFolder = "folder\path"
     If Right$(MyFolder, 1) <> "\" Then MyFolder = MyFolder & "\"

        fName = Dir(MyFolder & "*.xls")


        Do While Len(fName)
             Workbooks.Open Filename:= _
             MyFolder & fName
             ActiveWorkbook.Sheets("Rapport1").Select

             Call Macro1

             Name MyFolder & fName As MyFolder & Replace(fName, ".xls", ".xlsx", , , 1)
             fName = Dir()
        Loop

    End Sub

    Sub Macro1()

        lastligne = Range("B" & Rows.Count).End(xlUp).Row

        Sheets.Add After:=Sheets(Sheets.Count)
        Range("A1").Select
        ActiveCell.FormulaR1C1 = "yes"
        Range("A2").Select
        ActiveCell.FormulaR1C1 = "No"
        Sheets("Rapport1").Select
        Range("N3").Select
        With Selection.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:="=Feuil1!$A$1:$A$2"
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
        Selection.AutoFill Destination:=Range("N3:N" & lastligne), Type:=xlFillDefault

        ActiveWindow.SmallScroll ToRight:=3
        Range("Q3").Select
        With Selection.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:="=Feuil1!$A$1:$A$2"
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
        Selection.AutoFill Destination:=Range("Q3:Q" & lastligne), Type:=xlFillDefault
        Range("Q3:Q8").Select
        Range("S3").Select
        With Selection.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:="=Feuil1!$A$1:$A$2"
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
        Selection.AutoFill Destination:=Range("S3:S" & lastligne), Type:=xlFillDefault
        Range("S3:S8").Select
        Range("U3:V3").Select
        With Selection.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:="=$A$1:$A$2"
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
        Selection.AutoFill Destination:=Range("U3:V" & lastligne), Type:=xlFillDefault
        Range("U3:V8").Select
        ActiveWindow.SmallScroll ToRight:=5
        Range("X3").Select
        With Selection.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:="=Feuil1!$A$1:$A$2"
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
        Selection.AutoFill Destination:=Range("X3:X" & lastligne), Type:=xlFillDefault
        Range("X3:X8").Select
        ActiveWindow.SmallScroll ToRight:=4
        Range("Z3").Select
        With Selection.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:="=Feuil1!$A$1:$A$2"
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
        Selection.AutoFill Destination:=Range("Z3:Z" & lastligne), Type:=xlFillDefault
        Range("Z3:Z8").Select
        ActiveWindow.SmallScroll ToRight:=3
        Range("AB3").Select
        With Selection.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:="=Feuil1!$A$1:$A$2"
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
        Selection.AutoFill Destination:=Range("AB3:AB" & lastligne), Type:=xlFillDefault
        Range("AB3:AB8").Select
        Range("AD3").Select
        With Selection.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:="=Feuil1!$A$1:$A$2"
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
        Selection.AutoFill Destination:=Range("AD3:AD" & lastligne), Type:=xlFillDefault
        Range("AD3:AD8").Select
        ActiveWorkbook.Save
    End Sub

我的问题是在每个文件中创建下拉列表。请问怎么做？