如何编写VBA宏遍历Excel数据验证列表并按选项导出独立工作簿

需求说明 #

• 工作簿内存在名为sheet2的工作表
• sheet2的G1单元格已设置数据验证下拉列表

需要实现功能：自动遍历该下拉列表的所有选项，每选中一个选项就将当前对应内容导出为独立的Excel工作簿，文件名称使用G1当前选中的列表文本值。例如下拉列表有100个选项，最终输出100个对应名称的独立Excel文件。

原有参考代码（PDF导出版） #

以下为已验证可用的批量导出PDF功能代码，可作为逻辑参考：

Public Sub Create_PDFs()

Dim destinationFolder As String
Dim dataValidationCell As Range, dataValidationListSource As Range, dvValueCell As Range

destinationFolder = "C:\Users\DELL 04\Desktop\Q-Book Activities\Experiment"     'Same folder as workbook containing this macro
'destinationFolder = "C:\path\to\folder\"  'Or specific folder

If Right(destinationFolder, 1) <> "\" Then destinationFolder = destinationFolder & "\"
     
'Cell containing data validation in-cell dropdown

Set dataValidationCell = Worksheets("sheet2").Range("G1")
 
'Source of data validation list

Set dataValidationListSource = Evaluate(dataValidationCell.Validation.Formula1)
 
'Create PDF for each data validation value

For Each dvValueCell In dataValidationListSource
    dataValidationCell.Value = dvValueCell.Value
    With dataValidationCell.Worksheet.Range("A1:I45")
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=destinationFolder & dvValueCell.Value & ".PDF", _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    End With
Next
End Sub

适配Excel工作簿导出的VBA代码 #

在原有逻辑基础上修改，可实现批量导出独立Excel文件：

Public Sub Create_Excel_Files()
    Dim destinationFolder As String
    Dim dataValidationCell As Range, dataValidationListSource As Range, dvValueCell As Range
    Dim newWorkbook As Workbook
    Dim sourceSheet As Worksheet
    
    ' 设置导出文件保存路径，替换为你自己的文件夹路径
    destinationFolder = "C:\Users\DELL 04\Desktop\Q-Book Activities\Experiment"
    ' destinationFolder = "C:\自定义\保存路径\" ' 可修改为指定路径
    
    ' 路径末尾自动补全反斜杠
    If Right(destinationFolder, 1) <> "\" Then destinationFolder = destinationFolder & "\"
    
    ' 指定数据验证所在单元格
    Set dataValidationCell = Worksheets("sheet2").Range("G1")
    Set sourceSheet = dataValidationCell.Worksheet
    ' 获取数据验证下拉列表的数据源范围
    Set dataValidationListSource = Evaluate(dataValidationCell.Validation.Formula1)
    
    ' 遍历所有下拉选项
    For Each dvValueCell In dataValidationListSource
        ' 给G1单元格赋值为当前遍历的选项，触发工作表联动更新
        dataValidationCell.Value = dvValueCell.Value
        
        ' 新建空白工作簿
        Set newWorkbook = Workbooks.Add
        ' 复制指定范围的内容到新工作簿的第一个工作表
        sourceSheet.Range("A1:I45").Copy
        ' 以下行为粘贴数值，若需要保留公式可注释/删除该行
        newWorkbook.Sheets(1).Range("A1").PasteSpecial xlPasteValues
        ' 粘贴格式
        newWorkbook.Sheets(1).Range("A1").PasteSpecial xlPasteFormats
        
        ' 保存新工作簿，文件名为当前选项值
        newWorkbook.SaveAs Filename:=destinationFolder & dvValueCell.Value & ".xlsx", FileFormat:=xlOpenXMLWorkbook
        ' 关闭新工作簿
        newWorkbook.Close SaveChanges:=False
        
        ' 清空剪贴板
        Application.CutCopyMode = False
    Next
    
    ' 运行完成提示
    MsgBox "批量导出完成，共导出" & dataValidationListSource.Cells.Count & "个文件"
End Sub

使用注意事项 #

• 运行前请确认sheet2工作表存在，且G1单元格已设置有效的序列类数据验证
• 若需要调整导出的单元格范围，可修改代码中sourceSheet.Range("A1:I45")对应的区域参数
• 若下拉选项值包含\ / : * ? " < > |等Windows文件名禁用字符，需先清理数据源中的特殊字符避免保存报错
• 运行宏前请确保Excel已启用宏权限，当前工作簿保存为.xlsm格式

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