VBA 将工作表保存到当前文件夹

Question

我目前正在使用以下 VBA 将工作表另存为单独的文件，但是它将其保存到“我的文档”文件夹而不是工作簿所在的当前文件夹。

我正在寻找有关我可以添加的内容的帮助，以便将其保存到与文件所在的文件夹相同的文件夹中。我无法对文件路径进行硬编码，因为它每个月都会更改。

Sub SavePlan()
Dim Fname As String
Fname = Sheets("Main").Range("C6").Value
Sheets("Main").Copy
With ActiveWorkbook
    .SaveAs Filename:=Fname
    .Close
End With
End Sub

提前致谢

Answer 1

SaveAs 正在寻找要保存到的完整路径，因此使用ActiveWorkbook.Path来获取活动工作簿所在的目录，然后是 append \ 和 Fname （假设您在 Windows 中工作）。

Sub SavePlan()

  Dim Fname As String
  Fname = Sheets("Main").Range("C6").Value
  
  Sheets("Main").Copy
  With ActiveWorkbook
    .SaveAs Filename := ActiveWorkbook.Path & "\" & Fname
    .Close
    End With

End Sub

Answer 2

Sub SavePlan() Dim Fname As String With Sheets("Main") Fname = .Parent.Path & "\" & .Range("C6").Value .Copy End With With ActiveWorkbook .SaveAs Filename:=Fname .Close End With End Sub

Answer 3

将工作表备份到新工作簿

Option Explicit

Sub SavePlan()
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim sws As Worksheet: Set sws = wb.Worksheets("Main")
    
    Dim FolderPath As String: FolderPath = wb.Path
    Dim dFileName As String: dFileName = sws.Range("C6").Value
    Dim dFilePath As String
    dFilePath = FolderPath & Application.PathSeparator & dFileName
    
    sws.Copy ' copy to a new (destination) workbook
    
    Dim dwb As Workbook: Set dwb = Workbooks(Workbooks.Count)
    
    Application.DisplayAlerts = False ' overwrite without confirmation
    dwb.SaveAs Filename:=dFilePath
    Application.DisplayAlerts = True
    
    dwb.Close SaveChanges:=False

    MsgBox "Worksheet backed up.", vbInformation

End Sub