Option
Explicit
Sub
RangetoCSV_Export()
Dim
Rng
As
Range
Dim
WorkRng
As
Range
Dim
xFile
As
Variant
Dim
xFileString
As
String
xFileString =
"CSV-Transfer"
On
Error
Resume
Next
Set
WorkRng = Application.Selection
Application.ActiveSheet.Copy
Application.ActiveSheet.Cells.Clear
WorkRng.Copy Application.ActiveSheet.Range(
"A1"
)
Set
xFile = CreateObject(
"Scripting.FileSystemObject"
)
Application.ActiveWorkbook.SaveAs Filename:=xFileString, FileFormat:=xlCSV, CreateBackup:=
False
, Local:=
True
Application.ActiveWorkbook.Close
True
End
Sub