如何修改Excel拆分工作表的VBA代码以保留下拉列表工作表

方案一：拆分时附带数据源工作表 #

修改原有VBA代码，在复制目标工作表的同时，将存储下拉列表值的工作表（假设名为数据源，请根据实际名称修改）一同复制到新工作簿，让新文件保留下拉列表的依赖关系。如果不需要单独拆分数据源工作表，可以跳过对它的处理。

修改后的代码：

Sub SplitEachWorksheetWithSource()
    Dim FPath As String
    Dim ws As Worksheet
    Dim sourceWs As Worksheet
    Dim newWb As Workbook
    
    ' 替换成你实际的数据源工作表名称
    Set sourceWs = ThisWorkbook.Sheets("数据源")
    FPath = Application.ActiveWorkbook.Path
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    For Each ws In ThisWorkbook.Sheets
        ' 跳过数据源工作表本身，避免单独生成它的文件（不需要可删除此判断）
        If ws.Name <> sourceWs.Name Then
            ' 复制目标工作表到新工作簿
            ws.Copy
            Set newWb = Application.ActiveWorkbook
            ' 将数据源工作表复制到新工作簿末尾
            sourceWs.Copy After:=newWb.Sheets(newWb.Sheets.Count)
            
            ' 可选：隐藏数据源工作表，避免误操作
            newWb.Sheets(sourceWs.Name).Visible = xlSheetHidden
            
            ' 保存并关闭新工作簿
            newWb.SaveAs Filename:=FPath & "\" & ws.Name & ".xlsx"
            newWb.Close False
        End If
    Next ws
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

方案二：将下拉列表数据源转为本地值 #

如果不想每个文件都附带数据源工作表，可以批量修改原工作簿中各工作表的数据验证规则，把原本引用外部工作表的数据源直接转为当前工作表的静态值，拆分后的文件无需依赖其他表也能保留下拉功能。

实现代码：

Sub ConvertDataValidationToLocalValues()
    Dim ws As Worksheet
    Dim dv As DataValidation
    Dim sourceRange As Range
    Dim sourceValues As Variant
    
    Application.ScreenUpdating = False
    
    For Each ws In ThisWorkbook.Sheets
        ' 跳过数据源工作表
        If ws.Name <> "数据源" Then
            For Each dv In ws.DataValidations
                ' 只处理序列类型（下拉列表）的验证规则
                If dv.Type = xlValidateList Then
                    On Error Resume Next
                    ' 获取原数据源引用的区域
                    Set sourceRange = ThisWorkbook.Sheets("数据源").Range(Mid(dv.Formula1, 2))
                    On Error GoTo 0
                    
                    If Not sourceRange Is Nothing Then
                        ' 将数据源区域的值转为逗号分隔的字符串
                        sourceValues = sourceRange.Value
                        sourceValues = Join(Application.Transpose(sourceValues), ",")
                        ' 更新数据验证的数据源为本地值
                        dv.Formula1 = sourceValues
                    End If
                End If
            Next dv
        End If
    Next ws
    
    Application.ScreenUpdating = True
    MsgBox "数据验证规则转换完成，可执行原拆分代码"
End Sub

使用说明：先运行此代码处理原工作簿，再执行你原本的拆分代码即可。

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