Export a text file from each row of a spreadsheet
Hi Mike,
Am Sun, 15 Nov 2015 23:32:10 -0800 (PST) schrieb Greshter:
I.e. A B C D E F G
A1 0.1 0 0 -0.1 114 116
B1 0.1 0 0 -0.1 114 117
C1 0.1 0 0 -0.1 114 115
First text file would be named "A1" and would have the following text in it:
0.1
0
0
-0.1
114
116
try:
Sub WriteTxtFiles()
Dim LRow As Long, LCol As Long, i As Long, j As Long
Dim varOut() As Variant
Dim myFile As String, strOut As String
'Modify your path
Const myPath = "D:\Test\"
With ActiveSheet
LRow = .Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To LRow
LCol = .Cells(i, Columns.Count).End(xlToLeft).Column
myFile = myPath & .Cells(i, 1) & ".txt"
For j = 2 To LCol
ReDim Preserve varOut(LCol - 2)
varOut(j - 2) = .Cells(i, j)
Next
strOut = Join(varOut, vbCrLf)
Open myFile For Output As #1
Print #1, strOut
Close #1
Next
End With
End Sub
Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional
|