Option Explicit
Sub csvOut()
Dim ranRc As Range
Dim ranCr As Range
Dim i As Integer
Dim j As Integer
Dim strFileName As String
strFileName = "C:\Users\ak\Desktop\sss.csv" 'Application.GetSaveAsFilename()
Open strFileName For Output Access Write As #1
Set ranCr = Cells(1, 1).CurrentRegion
j = ranCr.Columns.Count - 1
For Each ranRc In ranCr.Rows
For i = 1 To j
Write #1, ranRc.Columns(i).Value;
Next i
Write #1, ranRc.Columns(i).Value
Next
Set ranCr = Nothing
Close #1
MsgBox "END"
End Sub