[SOLVED] Copying Sheet and Saving in Path of current Workbook

Copying Sheet and Saving in Path of current Workbook

I am trying to create a macro that copies a sheet from my current workbook and saves that sheet as a .csv file in the same path as my current workbook. Any help is appreciated.

Current Code I'm Working With

Option Explicit

Sub exportFirst()
  
    Const NewFilePath As String = ThisWorkbook.Path

    Dim SourceSheet As Worksheet
    Set SourceSheet = ThisWorkbook.ActiveSheet
    
    exportWorksheet SourceSheet, NewFilePath

End Sub

Sub exportWorksheet(SourceSheet As Worksheet, NewFilePath As String)

    Dim NewFileName As String
    Dim SaveLocation As String

     NewFileName = Range("V2").Value & " " & SourceSheet.Name

    SaveLocation = NewFilePath & "\" & NewFileName

    SourceSheet.Copy

    With ActiveWorkbook

       SaveLocation = SaveLocation & ".csv"
        .SaveAs FileFormat:=xlCSVUTF8, Filename:=SaveLocation

      End With

End Sub

Solution

Export Sheet to New Workbook

You have opted for the active sheet of the workbook and for the workbook's path, so it makes more sense to pass the workbook.
Here are some ideas on how to improve your code.

Sub ExportFirst()
  
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    ExportSheetToCSV wb, True, False
    ' The 2nd argument omitted or set to 'True' will save the (old) workbook
    ' before exporting so if the active sheet was (accidentally) modified,
    ' the original and its copy will have the same values.
    ' If you don't want that, set if to 'False'.
    ' The 3rd argument set to 'False' leaves the new workbook open
    ' so you can inspect what was copied.
    ' After testing, it makes more sense to omit it or set it to 'True'.

End Sub

Sub ExportSheetToCSV( _
        ByVal wb As Workbook, _
        Optional ByVal SaveWorkbookBeforeExport As Boolean = True, _
        Optional ByVal CloseNewWorkbook As Boolean = True)
    
    ' Define constants.
    Const PROC_TITLE As String = "Export Sheet to CSV"
    Const FILE_NAME_LEFT_CELL_ADDRESS As String = "V2"
    Const FILE_NAME_LEFT_DELIMITER As String = " "
    Const FILE_EXTENSION As String = ".csv"
    Const FILE_FORMAT As Long = xlCSVUTF8
    
    ' Exit if no path.
    Dim FolderPath As String: FolderPath = wb.Path
    If Len(wb.Path) = 0 Then
        MsgBox "The workbook """ & wb.Name & """ was never saved!" _
            & vbLf & "It has no path!", vbExclamation, PROC_TITLE
        Exit Sub
    End If
    
    ' Exit if not a worksheet.
    Dim sh As Object: Set sh = wb.ActiveSheet
    If Not TypeOf sh Is Worksheet Then
        MsgBox "The sheet """ & sh.Name & """ is not a worksheet!", _
            vbExclamation, PROC_TITLE
        Exit Sub
    End If
    
    ' Optionally, save the workbook.
    If SaveWorkbookBeforeExport Then
        If Not wb.Saved Then wb.Save
    End If
    
    ' Build the file path.
    Dim ws As Worksheet: Set ws = sh
    ' Assuming the cell has no error (there will be no error because of 'CStr')
    ' and is not blank.
    Dim NewFileName As String: NewFileName = _
        CStr(ws.Range(FILE_NAME_LEFT_CELL_ADDRESS).Value) _
        & FILE_NAME_LEFT_DELIMITER & ws.Name & FILE_EXTENSION
    Dim FilePath As String:
    FilePath = FolderPath & Application.PathSeparator & NewFileName
    
    ' Export the sheet as a new (single-sheet) workbook.
    ws.Copy
    Dim dwb As Workbook: Set dwb = Workbooks(Workbooks.Count)
    ' The line 'Set dwb = ActiveWorkbook' might fail (forgot why).
    
    ' Save the new workbook.
    Dim WasNewWorkbookSaved As Boolean: WasNewWorkbookSaved = True
    Application.DisplayAlerts = False ' overwrite without confirmation
        On Error GoTo SaveError ' start error-handling routine
            dwb.SaveAs Filename:=FilePath, FileFormat:=FILE_FORMAT
        On Error GoTo 0 ' end error-handling routine; restore default err. hand.
    Application.DisplayAlerts = True
     
    ' Close the new workbook.
    If WasNewWorkbookSaved Then
        If CloseNewWorkbook Then dwb.Close SaveChanges:=False
    Else ' new workbook not saved
        dwb.Close SaveChanges:=False
        Exit Sub
    End If
    
    ' Inform.
    MsgBox "Exported sheet """ & ws.Name & """ to """ & NewFileName & """.", _
        vbInformation, PROC_TITLE
    
    Exit Sub
SaveError: ' continue error-handling routine
    ' Invalid file name; a file with the same name is already open
    ' (could be in another location).
    MsgBox "Run-time error [" & Err.Number & "]:" & vbLf & vbLf _
        & Err.Description, vbCritical, PROC_TITLE
    WasNewWorkbookSaved = False
    Resume Next ' redirects to 'On Error GoTo 0'
End Sub