求助：遍历下拉菜单并将对应工作表数据复制至新工作簿

Alright, let's solve this problem once and for all—copying data for 20+ dropdown options manually is going to eat up way too much of your time. A quick VBA script will automate the whole process, and here's exactly how to do it:

1. 核心思路 #

• 遍历目标工作表（Sheet1「销售地点」和Sheet20「OSRs」）的A1下拉菜单所有选项
• 切换到每个选项，触发数据更新后复制A2:P115区域的内容
• 在新工作簿中为每个选项创建命名清晰的工作表（区分来源和选项名）
• 粘贴复制的数据，确保格式和数值准确

2. VBA代码实现 #

This script handles all the heavy lifting for you—just paste it into your workbook's VBA module:

Sub ExportAllDropdownData()
    Dim sourceWB As Workbook
    Dim newWB As Workbook
    Dim targetSheets As Variant
    Dim ws As Worksheet
    Dim dropdownCell As Range
    Dim dropdownOptions As Variant
    Dim i As Integer
    Dim targetWs As Worksheet
    Dim cleanOptionName As String
    
    ' 定义要处理的工作表名称
    targetSheets = Array("销售地点", "OSRs")
    ' 绑定当前源工作簿
    Set sourceWB = ThisWorkbook
    ' 创建新工作簿用于存放导出数据
    Set newWB = Workbooks.Add
    
    ' 遍历每个需要处理的工作表
    For Each ws In sourceWB.Sheets(targetSheets)
        ' 定位到A1的下拉菜单单元格
        Set dropdownCell = ws.Range("A1")
        
        ' 提取下拉菜单的所有选项（适配数据验证类型的下拉）
        If dropdownCell.Validation.Type = xlValidateList Then
            dropdownOptions = Split(dropdownCell.Validation.Formula1, ",")
            
            ' 遍历每个下拉选项
            For i = LBound(dropdownOptions) To UBound(dropdownOptions)
                ' 切换到当前选项
                dropdownCell.Value = dropdownOptions(i)
                ' 刷新数据（如果数据由公式/外部链接驱动，确保更新）
                sourceWB.RefreshAll
                
                ' 清理选项名称中的非法字符（避免工作表命名报错）
                cleanOptionName = Replace(dropdownOptions(i), "/", "-")
                cleanOptionName = Replace(cleanOptionName, "\", "-")
                cleanOptionName = Replace(cleanOptionName, ":", "-")
                
                ' 在新工作簿新建工作表并命名
                Set targetWs = newWB.Sheets.Add(After:=newWB.Sheets(newWB.Sheets.Count))
                targetWs.Name = ws.Name & "_" & cleanOptionName
                
                ' 复制源数据并粘贴值+格式（避免公式引用问题）
                ws.Range("A2:P115").Copy
                targetWs.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                Application.CutCopyMode = False
            Next i
        Else
            MsgBox ws.Name & "的A1不是数据验证下拉菜单，请检查！", vbExclamation
        End If
    Next ws
    
    ' 完成提示
    MsgBox "所有选项对应数据已成功导出到新工作簿！", vbInformation
End Sub

3. 使用步骤 #

• 打开你的源工作簿
• 按下Alt + F11打开VBA编辑器
• 右键点击左侧工程资源管理器中的你的工作簿名称 → 选择「插入」→「模块」
• 将上述代码粘贴到新建的模块中
• 按下F5运行代码，或者回到Excel界面，点击「开发工具」→「宏」→ 选择ExportAllDropdownData→ 执行

4. 注意事项 #

• 如果你的下拉菜单是表单控件（而非数据验证），请告诉我具体类型，我会调整代码适配
• 代码自动清理了选项名称中的非法字符（如/、\、:），确保工作表命名合法
• 若数据无需刷新（非公式/外部链接驱动），可以注释掉sourceWB.RefreshAll这一行
• 运行前建议备份源工作簿，避免意外问题

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