Generate Text Files

[Romulo Avila]

Good afternoon,


I have the data according to image, I need to generate text files of each block, for example the first block
refers to the range A1: A6, the second A7: A12 and the third A13: A18.
This file is for example only, the worksheet I need to break has more than 2,000 rows.
What differs each block and starting line and the end.

Thank you in advance for the help.

22332

[snb]

Sub M_snb()
sn = Columns(1).SpecialCells(2)

With CreateObject("scripting.filesystemobject")
For j = 1 To UBound(sn) Step 6
.createtextfile("G:\OF\file_" & Format(j, "0000")).write Join(Array(sn(j, 1), sn(j + 1, 1), sn(j + 2, 1), sn(j + 3, 1), sn(j + 4, 1), sn(j + 5, 1)), vbLf)
Next
End With
End Sub

[Romulo Avila]

SNB,
Good night, thank you for the help, I made the tests and verified that the generated files are not coming out formatted according to the sample worksheet, and also how to adjust, since I checked that the macro is set to generate 6 lines per file, which vary the amount of lines.
Thank you

[p45cal]

Try a variation:
Sub blah()
Set FSO = CreateObject("scripting.filesystemobject")
'With ActiveSheet.Range("a1").CurrentRegion.Resize(, 1)
With ActiveSheet.Columns(1).SpecialCells(2).Areas(1)
Set c = .Find(" ", after:=.Cells(.Cells.Count), LookIn:=xlValues, lookat:=xlPart, searchformat:=False)
If Not c Is Nothing Then
firstAddress = c.Address
Do
Set d = c
Set c = .FindNext(c)
i = i + 1
If c.Row > d.Row Then Set myRng = Range(d, c.Offset(-1)) Else Set myRng = Range(d, .Cells(.Cells.Count))
FSO.createtextfile("C:\Users\Public\Documents\file_" & Format(i, "0000")).write Join(Application.Transpose(myRng.Value), vbCrLf)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
End Sub

[Romulo Avila]

Good Morning,


Thank you very much for the help, it worked.