用于遍历下拉列表，然后将每次迭代的范围复制/粘贴到新选项卡中的VBA代码

Sub TraverseDropDownList()
    Dim ws As Worksheet
    Dim rngDropDown As Range
    Dim cell As Range
    Dim newSheet As Worksheet
    Dim i As Integer
    
    ' 设置工作表对象
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    ' 设置下拉列表的范围
    Set rngDropDown = ws.Range("A1:A10")
    
    ' 遍历下拉列表
    For Each cell In rngDropDown
        ' 创建新的选项卡
        Set newSheet = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
        
        ' 将当前迭代的范围复制到新选项卡中
        ws.Range(cell.Value).Copy newSheet.Range("A1")
        
        ' 重命名新选项卡
        newSheet.Name = "选项卡" & i
        
        ' 增加选项卡计数器
        i = i + 1
    Next cell
End Sub