VBA Export to CSV with Specified File Name

Hi All,

I'm looking for VBA code that will export the current worksheet to a CSV file, save it in a pre-determind file path, but allow the user to enter a custom file name.

The code that I'm currently using (below), works completely fine for exporting and saving in the correct path, but the user is unable to specify a file name. Any ideas?

Sub CopyToCSV()
Dim MyPath As String
Dim MyFileName As String
Application.DisplayAlerts = False
'The path and file names:
MyPath = "MY PATH HERE"
MyFileName = "CSV_Export_" & Format(Date, "ddmmyy")
'Makes sure the path name ends with "\":
If Not Right(MyPath, 1) = "\" Then MyPath = MyPath & "\"
'Makes sure the filename ends with ".csv"
If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv"
'Copies the sheet to a new workbook:
Sheets("CURRENT WORKSHEET").Copy
'The new workbook becomes Activeworkbook:
With ActiveWorkbook
'Saves the new workbook to given folder / filename:
    .SaveAs Filename:= _
        MyPath & MyFileName, _
        FileFormat:=xlCSV, _
        CreateBackup:=False
'Closes the file
    .Close False

Thanks a lot richard, that worked perfectly!

One more thing, if you've got a spare minute. The sheet I'm exporting is a Pivot Table, so lines 1 through 8 are blank or filters. Is there a way I can export only the data from A9 to the end of my data?

Thanks for your help,
Dom

Hi Richard,

Thanks for the quick response. Unfortunately, as the base spreadsheet is a Pivot Table, it's preventing me from deleting the first 8 rows. I'm receiving the below error message when running the macro.

Is there a way to bypass this error and delete them anyway?

Error.PNG

Thanks,
Dom

Hi Richard,

Worked like a charm. Had to edit slightly, pasted the values in to A1 and removed the line about deleting columns A:L. See complete working code below. Thank you for all of your help.

Sub CopyToCSV()
Dim MyPath As String
Dim MyFileName As String
'The path and file names:
MyPath = "G:\JSM & SYNERGY\JSM & SYNERGY\Dom TEST\MailMerge\CSV Files"
MyFileName = InputBox("Enter file name") & " " & Format(Date, "ddmmyy")
'Makes sure the path name ends with "\":
If Not Right(MyPath, 1) = "\" Then MyPath = MyPath & "\"
'Makes sure the filename ends with ".csv"
If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv"
'Copies the sheet to a new workbook:
Sheets("PIVOT").Copy
'The new workbook becomes Activeworkbook:
With ActiveWorkbook
'Replaces Pivot Data with Values only
With ActiveSheet.PivotTables("PivotTable1")
        .PivotSelect ""
        Selection.Copy
        Range("A1").PasteSpecial (xlPasteValuesAndNumberFormats)
'Deletes rows 1 to 8
        Rows("1:8").Delete
End With
'Saves the new workbook to given folder / filename:
    .SaveAs Filename:= _
        MyPath & MyFileName, _
        FileFormat:=xlCSV, _
        CreateBackup:=False
'Closes the file
    .Close False
End With
End Sub

Kind regards,
Dom