Splitting a single column from a file (csv), into several individual files (txt), evenly.

Hi guys,

I need help for making a code to split my master .csv file into multiple .txt files.

MY DATA

- My data is just the one column, from A1 to A1000

MY REQUIREMENT

1. I need to split a csv file, containin 1000 names, into 10 separate (equal sized) txt files.

2. I'd like those files to be named as follows:

Input_1_100.txt
Input_101_200.txt
Input_201_300.txt

(etc, etc)

It will be really helpful if someone can help me in this problem, i will be glad to provide sample data or further explanation if necessary.


Thank you greatly, in advance

-------------------------------


update Mon 03/03 6.10pm

Ive actually managed to convert the column into several rows, each row representing a txt file

Ive attached the new masterfile (contains macro and is macro enabled), as well as the resulting 10 files (4 of which ive attached)

The problem is that the names in each file appear in the one row, and not in a neat column (without spaces in between each line)

So it looks like this:

James.AJohn.ARobert.AMichael.AWilliam.ADavid.ARichard.AJoseph.ACharles.AThomas.AChristopher.A

Instead of this:

James.A
John.A
Robert.A
Michael.A
William.A
David.A
Richard.A
Joseph.A
Charles.A
Thomas.A
Christopher.A

Sub WriteTotxt()

Const forReading = 1, forAppending = 3, fsoForWriting = 2
Dim fs, objTextStream, sText As String
Dim lLastRow As Long, lRowLoop As Long, lLastCol As Long, lColLoop As Long

lLastRow = Cells(Rows.Count, 1).End(xlUp).Row

For lRowLoop = 1 To lLastRow

    Set fs = CreateObject("Scripting.FileSystemObject")
    Set objTextStream = fs.opentextfile("c:\temp\" & Cells(lRowLoop, 1) & ".txt", fsoForWriting, True)

    sText = ""

    For lColLoop = 1 To 7
        sText = sText & Cells(lRowLoop, lColLoop) & Chr(10) & Chr(10)
    Next lColLoop

    objTextStream.writeline (Left(sText, Len(sText) - 1))


    objTextStream.Close
    Set objTextStream = Nothing
    Set fs = Nothing

Next lRowLoop

End Sub

I'd appreciate any help on this

put this code in masterfile.csv, save as xlsm then run it

Sub Split_ToFiles()
LR = Cells(Rows.Count, "A").End(xlUp).Row
sFilePath = ActiveWorkbook.Path & "\"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set sh = ActiveSheet
n = 1
For i = 1 To 1000 Step 100
  Sheets.Add After:=Sheets(Sheets.Count)
  sh.Range("A" & i & ":A" & i + 99).Copy Cells(1, 1)
Next
For Each ws In Worksheets
  If ws.Name <> "masterfile" Then
    ws.Copy
    ActiveWorkbook.SaveAs Filename:=sFilePath & n & ".txt", FileFormat:=xlCSV, CreateBackup:=False
    ActiveWorkbook.Close
    ws.Delete
    n = n + 1
  End If
Next ws

Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Here's another method.

Sub Splitter100()
    
    Dim FF1 As Integer, FF2 As Integer, strName As String
    Dim vFile As Variant, strPath As String, strFileFilter As String
    Dim i As Long, j As Long
    
    ' Prompt user to select a file
    strFileFilter = "CSV Files (*.csv), *.csv, All Files (*.*),*.*"
    ChDrive "C"         ' Default drive
    ChDir "C:\Temp\"    ' Default directory
    vFile = Application.GetOpenFilename(strFileFilter, 2, "Please Select a File", "Open File", False)
    If Not TypeName(vFile) = "String" Then Exit Sub
    strPath = Left(vFile, InStrRev(vFile, Application.PathSeparator))
    
    FF1 = FreeFile()
    Open vFile For Input As #FF1
    
    For i = 1 To 1000 Step 100
        FF2 = FreeFile()
        OpenstrPath &  "Input_" & i & "_" & i + 99 & ".txt" For Output As #FF2
        For j = 1 To 100
            Input #FF1, strName
            Print #FF2, strName
        Next j
        Close #FF2
    Next i
    Close #FF1
    
    MsgBox "Names copied to files.", , "Copy Complete"
    
End Sub

duplicate post

Hi..

Add a CommandButton to your Master.csv file and save it as a xlsm file..

Private Sub CommandButton1_Click()
    Dim x As Long, Rng As Range
    For x = 1 To Range("A" & Rows.Count).End(xlUp).Row Step 100
        With CreateObject("Scripting.FileSystemObject").CreateTextFile("c:\" & x & "_" & x + 99 & ".txt", True)
            Set Rng = Cells(x, 1).Resize(100, 1)
            .writeline Join(Application.Transpose(Rng), vbCrLf)
        End With
    Next x
End Sub

@apo
very good and fast