Advertisement
Guest User

Untitled

a guest
Apr 30th, 2017
69
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 0.80 KB | None | 0 0
  1. Sub CSVFile()
  2. Dim SrcRg As Range
  3. Dim CurrRow As Range
  4. Dim CurrCell As Range
  5. Dim CurrTextStr As String
  6. Dim ListSep As String
  7. Dim FName As Variant
  8. FName = Application.GetSaveAsFilename("", "CSV File (*.csv), *.csv")
  9. ListSep = Application.International(xlListSeparator)
  10. If Selection.Cells.Count > 1 Then
  11. Set SrcRg = Selection
  12. Else
  13. Set SrcRg = ActiveSheet.UsedRange
  14. End If
  15. Open FName For Output As #1
  16. For Each CurrRow In SrcRg.Rows
  17. CurrTextStr = ìî
  18. For Each CurrCell In CurrRow.Cells
  19. If Not IsNumeric(CurrCell) Then
  20. CurrTextStr = CurrTextStr & """" & CurrCell.Value & """" & ListSep
  21. Else
  22. CurrTextStr = CurrTextStr & CurrCell.Value & ListSep
  23. End If
  24. Next
  25. While Right(CurrTextStr, 1) = ListSep
  26. CurrTextStr = Left(CurrTextStr, Len(CurrTextStr) - 1)
  27. Wend
  28. Print #1, CurrTextStr
  29. Next
  30. Close #1
  31. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement