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

基本上，我想将一些工作表保存到与原始笔记本相同的系统位置的单独的新工作簿中。如何使用Excel VBA将新工作簿另存为原始工作簿目录？

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

我在过去的几天里“学会了”VBA，所以你对其他事情的建议也很酷，但是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

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

来源

2014-10-31 jchemp

编辑这一行代码：

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

来源

2014-10-31 18:20:18

薄荷，新鲜;美丽。谢谢 – jchemp 2014-10-31 18:29:39

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

回答

相关问题