從下拉列表中

Question

創建文件夾層次結構文件的多個副本我有一個master Excel sheet設計吐出工資細節。表格中的數字由A2中的數據驗證下拉驅動，該數據驗證下拉列表填寫B2：G2，其中包含從數據選項卡提取的標識信息（Last，First，Region，PayPeriod，Year）。

我想什麼做的是有一個宏保存圖紙在下拉每個選擇的副本到特定文件夾中，根據在B2的信息層次：G2。

例如，

ID Last First Region PP Year 
10001 Smith Scott DC  PP1 2016 

我想，要保存在文件夾名爲C 「2016_PP1_DC_Smith_Scott.xlsx」 片：\ 2016 \ PP1 \ DC。

，然後改變到

ID Last First Region PP Year 
10002 Jones Karen NY  PP3 2015 

並保存在目錄C的片材 「2015_PP3_NY_Jones_Karen.xlsx」：\ 2015 \ PP3 \ NY。

我有一個宏這還有一段路。它會經過每個下拉菜單並以正確的文件名保存文件（雖然它正在重命名初始文件）（編輯）我需要幫助添加功能以將文件夾保存在文件夾層次結構中，而不會覆蓋最近的原始文檔保存的圖紙名稱。

與繼續使用這個宏了修改或從頭開始完全正常。

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 

謝謝你們的幫助！如果你感覺冗長，那麼在你的回覆中提供一些細節是很好的，這樣我就可以學習。

Answer 1

編輯反映最可能驗證工作表名稱

也許你像什麼如下之後：

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