1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46
| 'https://excelribbon.tips.net/T009243_Specifying_a_Delimiter_when_Saving_a_CSV_File_in_a_Macro.html
Sub CreateFile()
Dim sFName As String
Dim Rows As Long
Dim Cols As Long
Dim J As Long
Dim K As Long
Dim sTemp As String
Dim sSep As String
sSep = ";" 'Specify the separator to be used
sFName = ActiveWorkbook.FullName
If sFName Like "*.xls*" Then
sFName = Left(sFName, InStrRev(sFName, "."))
sFName = sFName & "txt"
Open sFName For Output As 1
With ActiveSheet
'Number of rows to export is based on the contents
'of column B. If it should be based on a different
'column, change the following line to reflect the
'column desired.
Rows = .Cells(.Rows.Count, "B").End(xlUp).Row
For J = 1 To Rows
sTemp = ""
Cols = .Cells(J, .Columns.Count).End(xlToLeft).Column
For K = 2 To Cols
sTemp = sTemp & .Cells(J, K).Value
If K < Cols Then sTemp = sTemp & sSep
Next
Print #1, sTemp
Next J
End With
Close 1
sTemp = "There were " & Rows & " rows of data written "
sTemp = sTemp & "to this file:" & vbCrLf & sFName
Else
sTemp = "This macro needs to be run on a workbook "
sTemp = sTemp & "stored in the .XLS* format."
End If
MsgBox sTemp
End Sub |
Partager