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

时间:2014-10-31 18:09:39

标签: excel vba excel-vba filepath save-as

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

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

我在过去的几天里“学会了”VBA,所以你注意到的其他事情的建议也很酷,但是救命是困扰我的。

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

如果我没有遵循正确的stackoverflow格式,请告诉我。 长期用户第一次询问者:)

1 个答案:

答案 0 :(得分:1)

在代码中编辑此行:

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