How to save each row of a spreadsheet as separate text files?

Copper Contributor

I have a spreadsheet with >4000 rows, where each row has 2 columns. I need separate txt files containing each report and hopefully each file under the name of the respective ID.

How can I do that? An example of the structure of the data:

ID (number)Report (text)
1645Today is a beautiful day... 
1967Today the sun is shinning

 

3 Replies

@maxim545 

Sub SaveAsTextFile()
    Dim strPath As String
    Dim lngID As Long
    Dim strReport As String
    Dim r As Long
    Dim m As Long
    ' Specify a different path if you wish
    strPath = ThisWorkbook.Path & Application.PathSeparator
    ' Last row
    m = Range("A" & Rows.Count).End(xlUp).Row
    ' Loop through the rows
    For r = 2 To m
        ' Get ID and Report
        lngID = Range("A" & r).Value
        strReport = Range("B" & r).Value
        ' Open text file
        Open strPath & lngID & ".txt" For Output As #1
        ' Write data
        Print #1, lngID; Tab; strReport
        ' Close the file
        Close #1
    Next r
End Sub

Hi Hans,

I need a very similar routine, but I need to read the whole row, which may contain a different amount of cells. Can you help me?

@Hans Vogelaar 

@KIKEMAN78 Assuming your version of Excel has the worksheet function TEXTJOIN, append the following into the macro from @Hans Vogelaar 

 

__/ before row 9, insert

Columns("b:b").Insert 'add a temporary column for calculation
Range(Range("b1"), "b" & Range("b1").SpecialCells(xlCellTypeLastCell).Row).Select 'select matching "last" row
Selection.FormulaR1C1 = "=TEXTJOIN(CHAR(9),0,RC[1]:RC[16382])" 'join all texts but col A

 

__/ before End Sub, insert
Columns("b:b").Delete 'delete the temporary column

 

Column B will temporarily join all cells to its right, including empty ones, to be exported as @Hans Vogelaar code, and then deleted to reset the file.

If you want to exclude empty cells, change the zero to one
TEXTJOIN(CHAR(9),0, to TEXTJOIN(CHAR(9),1,