XLS to CSV Code Problem
 

I am using the code below to convert (and save) a worksheet to a csv file.
For some reason, the code is not saving the entire contents of the worksheet.

Can someone recommend a change to the code so that it will convert and save
the entire contents of the selected worksheet ?

Thank you in advance.

Sheets(Array("1", "2")).Select

Sheets("1").Activate

' save selected sheets as individual workbooks and convert to csv

'

ChDir "J:\PROJECTS\close"

Dim sh As Worksheet

Dim Nwb As Workbook

Application.ScreenUpdating = False

For Each sh In ActiveWindow.SelectedSheets

sh.Copy

Set Nwb = ActiveWorkbook

Nwb.SaveAs Filename:=sh.Name & "_" & Format(Now, "mm-dd-yy")

Nwb.Close False

Next

'Application.ScreenUpdating = True

'ActiveWorkbook.Close savechanges:=False



'convert selected sheets to csv





Dim FName As Variant

Dim N As Long

Dim Awb As Workbook

FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xls),
*.xls", _

MultiSelect:=True)



If IsArray(FName) Then

Application.ScreenUpdating = False

For N = LBound(FName) To UBound(FName)

Set Awb = Workbooks.Open(FName(N))



ExportToTextFile Left(Awb.Name, Len(Awb.Name) - 4) & ".csv",
";", False



Awb.Close savechanges:=False

Next

Application.ScreenUpdating = True

End If



Application.ScreenUpdating = True

ActiveWorkbook.Close savechanges:=False

End Sub



Public Sub ExportToTextFile(FName As String, Sep As String, SelectionOnly As
Boolean)



Dim WholeLine As String

Dim FNum As Integer

Dim RowNdx As Long

Dim ColNdx As Integer

Dim StartRow As Long

Dim EndRow As Long

Dim StartCol As Integer

Dim EndCol As Integer

Dim CellValue As String





Application.ScreenUpdating = False

On Error GoTo EndMacro:

FNum = FreeFile



If SelectionOnly = True Then

With Selection

StartRow = .Cells(1).Row

StartCol = .Cells(1).Column

EndRow = .Cells(.Cells.Count).Row

EndCol = .Cells(.Cells.Count).Column

End With

Else

With ActiveSheet.UsedRange

StartRow = .Cells(1).Row

StartCol = .Cells(1).Column

EndRow = .Cells(.Cells.Count).Row

EndCol = .Cells(.Cells.Count).Column

End With

End If



Open FName For Output Access Write As #FNum



For RowNdx = StartRow To EndRow

WholeLine = ""

For ColNdx = StartCol To EndCol

If Cells(RowNdx, ColNdx).Value = "" Then

CellValue = Chr(34) & Chr(34)

Else

CellValue = Cells(RowNdx, ColNdx).Text

End If

WholeLine = WholeLine & CellValue & Sep

Next ColNdx

WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))

Print #FNum, WholeLine

Next RowNdx



EndMacro:

On Error GoTo 0

Application.ScreenUpdating = True

Close #FNum



End Sub