Try it ( tested on a simple data set )
Private Sub ExportToCsv()
Dim ws As Worksheet
Dim delim As String, LastCol As String, csvFile As String, CsvLine As String
Dim aCell As Range, DataRange As Range
Dim ff As Long, lRow As Long, lCol As Long
Dim i As Long, j As Long
'~~> We use "," as delimiter
delim = ","
'~~> Change this to specify your file name and path
csvFile = "C:\Users\Siddharth\Desktop\Sample.Csv"
'~~> Change this to the sheet which you want to export as csv
Set ws = ThisWorkbook.Sheets("Sheet9")
With ws
'~~> Find last row and last column
lRow = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
lCol = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
'~~> Column number to column letter
LastCol = Split(Cells(, lCol).Address, "$")(1)
'~~> This is the range which will be exported
Set DataRange = .Range("A1:" & LastCol & lCol)
'
'~~> Loop through cells in the range and write to text file
'
ff = FreeFile
Open csvFile For Output As #ff
For i = 1 To lRow
For j = 1 To lCol
CsvLine = CsvLine & (delim & Replace(.Cells(i, j).Value, """", """"""""))
Next j
Print #ff, Mid(CsvLine, 2)
CsvLine = ""
Next
'~~> Close text file
Close #ff
End With
End Sub
source
share