我有一個用作模板檔案的 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
uj5u.com熱心網友回復：
我認為您想放入代碼中的是：
MkDir "C:\yourFolderPath"
這將創建目錄，然后您必須將檔案保存到其中。
uj5u.com熱心網友回復：
將作業表復制到子檔案夾
- 使用變數使代碼更具可讀性和可維護性。
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
轉載請註明出處，本文鏈接：https://www.uj5u.com/yidong/384778.html