如何在按主管列批量创建工作簿的VBA循环中添加三选项数据验证下拉？

原代码功能是按Data工作表D列的主管姓名拆分数据到独立工作簿，现在需要给每个新工作簿新增一列，添加包含1、2、3选项的下拉数据验证。之前尝试插入下拉列表代码时报错，不清楚正确的放置位置和写法。

原拆分代码：

Option Explicit

Sub Split_Data_in_workbooks()

Application.ScreenUpdating = False

Dim data_sh As Worksheet
Set data_sh = ThisWorkbook.Sheets("Data")

Dim setting_Sh As Worksheet
Set setting_Sh = ThisWorkbook.Sheets("Settings")

Dim nwb As Workbook
Dim nsh As Worksheet

''''' Get unique supervisors
setting_Sh.Range("A:A").Clear
data_sh.AutoFilterMode = False
data_sh.Range("D:D").Copy setting_Sh.Range("A1")

setting_Sh.Range("A:A").RemoveDuplicates 1, xlYes

Dim i As Integer

For i = 2 To Application.CountA(setting_Sh.Range("A:A"))

data_sh.UsedRange.AutoFilter 4, setting_Sh.Range("A" & i).Value

Set nwb = Workbooks.Add
Set nsh = nwb.Sheets(1)

data_sh.UsedRange.SpecialCells(xlCellTypeVisible).Copy nsh.Range("A1")
nsh.UsedRange.EntireColumn.ColumnWidth = 15

nwb.SaveAs setting_Sh.Range("H6").Value & "/" & setting_Sh.Range("A" & i).Value & ".xlsx"
nwb.Close False
data_sh.AutoFilterMode = False
Next i

setting_Sh.Range("A:A").Clear

MsgBox "Done"

End Sub

之前尝试的下拉列表代码：

Sub DropDownListinVBA()

Range("E2").Validation.Add Type:=xlValidateList, _
                           AlertStyle:=xlValidAlertStop, _
                           Formula1:="1,2,3"

End Sub

Option Explicit

Sub Split_Data_in_workbooks()

Application.ScreenUpdating = False

Dim data_sh As Worksheet
Set data_sh = ThisWorkbook.Sheets("Data")

Dim setting_Sh As Worksheet
Set setting_Sh = ThisWorkbook.Sheets("Settings")

Dim nwb As Workbook
Dim nsh As Worksheet
Dim lastRow As Long ''新增变量，用于获取数据最后一行

''''' Get unique supervisors
setting_Sh.Range("A:A").Clear
data_sh.AutoFilterMode = False
data_sh.Range("D:D").Copy setting_Sh.Range("A1")

setting_Sh.Range("A:A").RemoveDuplicates 1, xlYes

Dim i As Integer

For i = 2 To Application.CountA(setting_Sh.Range("A:A"))

data_sh.UsedRange.AutoFilter 4, setting_Sh.Range("A" & i).Value

Set nwb = Workbooks.Add
Set nsh = nwb.Sheets(1)

data_sh.UsedRange.SpecialCells(xlCellTypeVisible).Copy nsh.Range("A1")
nsh.UsedRange.EntireColumn.ColumnWidth = 15

''===== 这里是新增的下拉列表代码 =====
lastRow = nsh.Cells(nsh.Rows.Count, "A").End(xlUp).Row ''获取数据最后一行行号
nsh.Range("E1").Value = "选择项" ''给新增列加表头
' 先清除目标区域已有的数据验证（避免重复添加报错）
nsh.Range("E2:E" & lastRow).Validation.Delete
' 添加数据验证下拉列表
nsh.Range("E2:E" & lastRow).Validation.Add _
    Type:=xlValidateList, _
    AlertStyle:=xlValidAlertStop, _
    Formula1:="1,2,3"
''===== 新增代码结束 =====

nwb.SaveAs setting_Sh.Range("H6").Value & "/" & setting_Sh.Range("A" & i).Value & ".xlsx"
nwb.Close False
data_sh.AutoFilterMode = False
Next i

setting_Sh.Range("A:A").Clear

MsgBox "Done"

End Sub

1. 放置位置：必须在data_sh.UsedRange.SpecialCells(xlCellTypeVisible).Copy nsh.Range("A1")之后，nwb.SaveAs之前——只有复制完数据，才能确定新增列的范围，且要在保存前完成设置。
2. 指定工作表：之前报错的核心原因是直接用Range("E2")，没有指定是新工作簿的工作表nsh，VBA会默认使用当前活动表，导致操作对象错误。
3. 覆盖有效范围：只给E2加验证意义不大，所以新增lastRow变量获取数据最后一行，给E2到E[lastRow]的整个数据区域添加验证。
4. 清除旧验证：添加前先执行Validation.Delete，避免因目标区域已有验证导致报错。

内容的提问来源于stack exchange，提问作者BarryHubez