如何在VBA中的每个excel文件的某个列中创build一个下拉列表？

我尝试在每个excel文件的某个列中创build一个下拉列表，之后我需要将这些更改保存在一个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 

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