如何使用Excel VBA将新工作簿另存为原始工作簿目录？

基本上，我想将一些工作表保存到与原始笔记本相同的系统位置的单独的新工作簿中。

我认识到，默认path是保存新的东西到当前笔记本的位置，但也许因为我打开一个新的工作簿默认恢复到用户的文档文件夹，这是他们现在保存的位置。

在过去的几天里，我“学会了”VBA，所以对于你注意到的其他事情的build议也是很酷的，但是saveas是困扰着我的东西。

Dim ws As Worksheet Dim wb As Workbook Dim dept_array As Variant Dim dept As Variant ' Add or remove a department name spelled exactly as it is in the filter dept_array = Array("HR", "IT", "Marketing", "Product Marketing", "Sales", "Channels", "Presales", "Direct", "Sales Ops", "R&D", "Support", "G&A") Application.ScreenUpdating = False For Each ws In Workbooks("Weekly Department Transaction Report.xlsm").Worksheets For Each dept In dept_array If Application.Proper(ws.Name) = Application.Proper(dept) _ Then Set wb = Workbooks.Add ThisWorkbook.Sheets(dept).Copy Before:=wb.Sheets(1) wb.Saveas dept & "_" & Format(Now, "yyyymmdd") & ".xlsx" Workbooks("Weekly Department Transaction Report.xlsm").Sheets("Codes").Copy After:=Workbooks(dept & "_" & Format(Now, "yyyymmdd") & ".xlsx").Sheets(dept) Workbooks("Weekly Department Transaction Report.xlsm").Sheets("How").Copy Before:=Workbooks(dept & "_" & Format(Now, "yyyymmdd") & ".xlsx").Sheets(dept) Workbooks(dept & "_" & Format(Now, "yyyymmdd") & ".xlsx").Save End If Next dept Next ws Application.ScreenUpdating = True End Sub 

请让我知道，如果我没有遵循正确的计算器格式。 长期用户第一次提问:)

Answer 1

在你的代码中编辑这一行：

 wb.SaveAs FileName:= ThisWorkbook.Path & "\" & dept & "_" & Format(Now, "yyyymmdd") & ".xlsx"