将单个文件夹添加到创建的文件中

Question

我有一个excel文件，它用作模板文件，需要根据名称列表生成新文件。

如何将它们保存在与文件(人名(同名的单独文件夹中。

这就是我所拥有的：

Sub SaveMasterAs()
Dim wb As Workbook
Dim rNames As Range, c As Range, r As Range
'Current file's list of names and ids on sheet1.
Set rNames = Worksheets("Sheet1").Range("A2", Worksheets("Sheet1").Range("A2").End(xlDown))
'Path and name to master workbook to open for copy, saveas.
Set wb = Workbooks.Open(ThisWorkbook.Path & "template_2021.xlsm")
For Each c In rNames
With wb
.SaveAs Filename:=ThisWorkbook.Path & "templates" & c.Value & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End With
Set wb = ActiveWorkbook
Next c
wb.Close
End Sub

Answer 1

我认为您想在代码中放入的是：

MkDir "C:yourFolderPath"

这将创建目录，然后您必须将文件保存到其中

Answer 2

将工作表复制到子文件夹

• 使用变量使代码更具可读性和可维护性

Option Explicit
Sub SaveMasterAs()

Dim swb As Workbook: Set swb = ThisWorkbook
Dim sws As Worksheet: Set sws = swb.Worksheets("Sheet1")

'Current file's list of names and ids on sheet1.
Dim rNames As Range
Set rNames = sws.Range("A2", sws.Range("A2").End(xlDown))
' This is usually the preferred (safer) way:
'Set rNames = sws.Range("A2", sws.Range("A" & sws.Rows.Count).End(xlUp))

'Path and name to master workbook to open for copy, saveas.
Dim dwb As Workbook
Set dwb = Workbooks.Open(swb.Path & "template_2021.xlsm")

Dim c As Range
Dim cString As String
Dim dFolderPath As String
Dim dFilePath As String

For Each c In rNames.Cells
cString = CStr(c.Value)
If Len(cString) > 0 Then ' not a blank cell
dFolderPath = swb.Path & "templates" & cString
If Len(Dir(dFolderPath, vbDirectory)) = 0 Then
MkDir dFolderPath
End With
dFilePath = dFolderPath & "" & cString & ".xlsm"
dwb.SaveAs Filename:=dFilePath, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End If
Next c

dwb.Close SaveChanges:=False ' just in case
End Sub