Question

我将如何转动：

 Dim sPath As String
  sPath = "M:\Lvl3-5Mgrs\"
If Len(Dir(sPath & Format(Date, "yyyy_mm_dd"), vbDirectory)) = 0 Then
 MkDir (sPath & Format(Date, "yyyy_mm_dd"))
End If
End Sub

一种通过我作为文件名放入的列表中的单元格值创建文件夹的方法：位于工作表（“ mrkt_leader”）中的 VBA_2018_Mid_Year_File 列表。

因此，如果我在工作表中有10个市场领导者，则我希望10个文件夹中的市场领导者拥有自己的文件夹。

然后，如果这是我当前拥有的内容，那么我如何将每个经过过滤的新文件保存在该附加文件夹层中？

.SaveAs Filename:="M:\Pittsburgh\GRP4\HR_PCorpComp\Retail\!Mid-Year\Mid Year 2018\Reporting\TCR\Lvl3-5Mgrs\" & Format(Date, "yyyy_mm_dd") & "\" & Format(Date, "yyyy_mm_dd_") & Manager, FileFormat:=xlOpenXMLWorkbook

如果有帮助，这里是整个脚本（它根据助手工作表列表以及要挑选的经理筛选出特定的经理范围）：

    Option Explicit

        Sub Lvl4Mgr()
              Dim Managers, Manager, Leader
              Dim Header As Range, Where As Range, This As Range
              Dim Wb As Workbook

              'Prepare
              Application.ScreenUpdating = False
              Application.DisplayAlerts = False

              'Refer to the headings
              Set Header = Range("A1").EntireRow
              'Refer to all managers in level4
              Set Where = Range("AS2", Range("AS" & Rows.Count).End(xlUp))
              'Get the managers
              With Worksheets("Lvl4")
                Set Managers = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
              End With
              'Loop through
              For Each Manager In Managers
                'Find them
                Set This = FindAll(Where, Manager)
                If This Is Nothing Then GoTo Skip
                'Create a new file
                Set Wb = Workbooks.Add(XlWBATemplate.xlWBATWorksheet)
                With Wb
                  With .Sheets(1)
                    'Copy the header
                    Header.Copy .Range("A1")
                    'Copy the data
                    This.EntireRow.Copy .Range("A2")
                  End With
                  With .Sheets(1)
                  Cells.EntireColumn.AutoFit
                  End With
                   Columns("C:C").NumberFormat = "mm/dd/yyyy"
                   Columns("BN:BN").NumberFormat = "mm/dd/yyyy"
                    Rows("1:1").AutoFilter
                 'Save it
                  .SaveAs Filename:="M:\Lvl3-5Mgrs\" & Format(Date, "yyyy_mm_dd") _
                  & "\" & Format(Date, "yyyy_mm_dd_") & Manager, FileFormat:=xlOpenXMLWorkbook, Password:="Ville18$"
        .Close
                End With
Skip:
                    Next
                    'Done




            End Sub

Answer 1

您能否解释一下数据的结构以及这是什么意思？也就是说，您是否要从另一张工作表的当前数据集中挑选经理？

通常，如果您遍历列表并为每个列表创建一个文件夹，则可以执行以下操作

Dim MainPath As String
Dim ManagerName As String
Dim ManagerFolder As String

MainPath = "M:\Lvl3-5Mgrs\"

With Worksheets("Lvl4")
    For Each Manager In Managers
        ManagerFolder = MainPath & Manager.Value
        If Dir(ManagerFolder, vbDirectory) = vbNullString Then
            MkDir (ManagerFolder)
        End If
End With

如何通过单元格值创建文件夹？

1 个答案: