Exporting set of data to CSV file using worksheet name

[jstarr]

I currently have an excel spreadsheet that has a macro that I found in these forums built into it. The macro takes a range of data and exports it to save as a .csv file. It currently saves as the same name as the excel spreadsheet. How do I modify the macro in order to have the file save as the name of the worksheet that is being exported?
The macro being used is below:

Public Sub ExcelRowsToCSV()

Dim iPtr As Integer
Dim sFileName As String
Dim intFH As Integer
Dim aRange As Range
Dim iLastColumn As Integer
Dim oCell As Range
Dim iRec As Long

Set aRange = Range("P1:z200")
iLastColumn = aRange.Column + aRange.Columns.Count - 1

iPtr = InStrRev(ActiveWorkbook.FullName, ".")
sFileName = Left(ActiveWorkbook.FullName, iPtr - 1) & ".csv"
sFileName = Application.GetSaveAsFilename(InitialFileName:=sFileName, FileFilter:="CSV (Comma delimited) (*.csv), *.csv")
If sFileName = "False" Then Exit Sub

Close
intFH = FreeFile()
Open sFileName For Output As intFH

iRec = 0
For Each oCell In aRange
If oCell.Column = iLastColumn Then
Print #intFH, oCell.Value
iRec = iRec + 1
Else
Print #intFH, oCell.Value; ",";
End If
Next oCell

Close intFH

MsgBox "Finished: " & CStr(iRec) & " records written to " _
& sFileName & Space(10), vbOKOnly + vbInformation

End Sub

 

[Joe4]

Welcome to the Board!

Replace this:

[COLOR=#333333]iPtr = InStrRev(ActiveWorkbook.FullName, ".")[/COLOR]
[COLOR=#333333]sFileName = Left(ActiveWorkbook.FullName, iPtr - 1) & ".csv"[/COLOR]

with this:

sFileName = ActiveSheet.Name & ".csv"