VBA to save worksheet to current folder-CodePudding

I'm currently using the following VBA to save a worksheet as a separate file, however it saves it to the My Documents folder instead of the current folder the workbook is in.

I'm looking help on what I could add so that it saves to the same folder as the file is already in. I can't hardcode a filepath in as it will change each month.

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

Thanks in advance

CodePudding user response：

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

CodePudding user response：

Backup Worksheet to a New Workbook

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

CodePudding user response：

Initial answer used ActiveWorkbook. BigBen points out that after the copy, ActiveWorkbook changes to the copy of the worksheet. Edited to use ThisWorkbook instead. You could also move the path acquisition to before the copy and still use ActiveWorkbook. I am including both.

SaveAs is looking for the full path to save to, so either use ActiveWorkbook.Path before the copy to get the directory the active workbook is in, then append \ and Fname to it (assuming you are working in Windows), or use ThisWorkbook.Path after the copy.

With ActiveWorkbook:

Sub SavePlan()

  Dim Fname As String, Fpath as string
  Fname = Sheets("Main").Range("C6").Value
  Fpath = ActiveWorkbook.Path

  Sheets("Main").Copy
  With ActiveWorkbook
    .SaveAs Filename := Fpath & "\" & Fname
    .Close
    End With

End Sub

With ThisWorkbook:

Sub SavePlan()

  Dim Fname As String
  Fname = Sheets("Main").Range("C6").Value

  Sheets("Main").Copy
  With ActiveWorkbook
    .SaveAs Filename := ThisWorkbook.Path & "\" & Fname
    .Close
    End With

End Sub