从下拉列表中创build文件夹层次结构中的多个文件副本
我有一个主要的Excel工作表，旨在吐出工资单细节。 表格中的数字由A2中的数据validation下拉列表驱动，该数据validation下拉列表填写B2：G2，其中包含从数据选项卡拉取的标识信息（Last，First，Region，PayPeriod，Year）。
我想要做的是有一个macros，根据B2：G2中的信息，将下拉列表中每个选项的表格副本保存到层次结构中的特定文件夹中。
例如，
ID Last First Region PP Year 10001 Smith Scott DC PP1 2016 我希望在文件夹C：\ 2016 \ PP1 \ DC中保存名为“2016_PP1_DC_Smith_Scott.xlsx”的工作表。
然后改变
ID Last First Region PP Year 10002 Jones Karen NY PP3 2015
并将文件“2015_PP3_NY_Jones_Karen.xlsx”保存在文件夹C：\ 2015 \ PP3 \ NY中。
我有一个macros，这是那里的一部分。 它通过每一个下拉菜单，并保存文件的正确的文件名（虽然它正在重命名的初始文件）（编辑）我需要帮助添加function，以保存工作表中的文件夹层次结构，而不是覆盖最新的原始文件保存的图纸名称。
继续使用这个macros编辑或从头开始完全罚款。
Sub PrintValidationChoices() Dim wbSource As Workbook Dim r As Long, i As Long Dim relativePath As String Dim year As String Dim quarter As String Dim pp As String Dim region As String Dim doctor As String Set wbSource = ActiveWorkbook r = Range("ID").Cells.Count For i = 1 To r Range("A2") = Range("ID").Cells(i) year = ActiveSheet.Range("G2") pp = ActiveSheet.Range("F2") region = ActiveSheet.Range("E2") hospital = ActiveSheet.Range("D2") doctor = ActiveSheet.Range("B2") & "_" & ActiveSheet.Range("C2") 'visually validating what will be used - not needed Range("H3") = year Range("H4") = pp Range("H5") = region Range("H6") = hospital Range("H7") = doctor sname = year & "_" & pp & "_" & region & "_" & hospital & "_" & doctor & ".xls" relativePath = wbSource.Path & "\" & sname 'use path of wbSource Range("H8") = relativePath Application.DisplayAlerts = False ActiveWorkbook.CheckCompatibility = False ActiveWorkbook.SaveAs Filename:=relativePath, FileFormat:=xlExcel8 Application.DisplayAlerts = True Application.Wait (Now + TimeValue("00:00:01")) 'pausing to see actions - not needed Next i Range("A2") = Range("ID").Cells("1") 'return to start of list MsgBox "Done!" End Sub
谢谢你们的帮助！ 如果你感觉冗长，那么在你的回复中有一些细节是很好的，所以我可以学习。
编辑以反映最可能的validation工作表名称
也许你是在追求如下的东西：
Option Explicit Sub main() Dim strng As String Dim cell As Range With Worksheets("Report") '<--| change "Report" to your actual worksheet name For Each cell In Range(.Range("a2").Validation.Formula1).SpecialCells(XlCellType.xlCellTypeConstants) .Range("a2") = cell.Value SaveWorksheet .Range("B2:G2") Next cell End With End Sub Sub SaveWorksheet(rng As Range) Dim sname As String, relativePath As String Dim folder As String folder = "C:\" & rng(1, 6) & "_" & rng(1, 5) & "_" & rng(1, 4) MkDir folder sname = rng(1, 6) & "_" & rng(1, 5) & "_" & rng(1, 4) & "_" & rng(1, 3) & "_" & rng(1, 2) & "_" & rng(1, 3) & ".xls" relativePath = folder & "\" & sname Application.DisplayAlerts = False ActiveWorkbook.CheckCompatibility = False rng.Parent.Copy With ActiveWorkbook .SaveAs filename:=relativePath ', FileFormat:=xlExcel8 .Close End With Application.DisplayAlerts = True Application.Wait (Now + TimeValue("00:00:01")) 'pausing to see actions - not needed End Sub