Create text Files from every row in an Excel spreadsheet

后端 未结 4 1838
死守一世寂寞
死守一世寂寞 2020-12-01 20:29

I need help creating separate text files from each row in an excel spread sheet called \"worksheet\". I want the text files to be named with content of Column A, with colum

4条回答
  •  情歌与酒
    2020-12-01 20:45

    @nutsch's answer is perfectly fine and should work 99.9% of the time. In the rare occasion that FSO is not available, here's a version that doesn't have a dependency. As is, it does require that the source worksheet doesn't have any blank rows in the content section.

    Sub SaveRowsAsCSV()
    
    Dim wb As Excel.Workbook, wbNew As Excel.Workbook
    Dim wsSource As Excel.Worksheet, wsTemp As Excel.Worksheet
    Dim r As Long, c As Long
    
        Set wsSource = ThisWorkbook.Worksheets("worksheet")
    
        Application.DisplayAlerts = False 'will overwrite existing files without asking
    
        r = 1
        Do Until Len(Trim(wsSource.Cells(r, 1).Value)) = 0
            ThisWorkbook.Worksheets.Add ThisWorkbook.Worksheets(1)
            Set wsTemp = ThisWorkbook.Worksheets(1)
    
            For c = 2 To 7
                wsTemp.Cells((c - 1) * 2 - 1, 1).Value = wsSource.Cells(r, c).Value
            Next c
    
            wsTemp.Move
            Set wbNew = ActiveWorkbook
            Set wsTemp = wbNew.Worksheets(1)
            'wbNew.SaveAs wsSource.Cells(r, 1).Value & ".csv", xlCSV 'old way
            wbNew.SaveAs "textfile" & r & ".csv", xlCSV 'new way
            'you can try other file formats listed at http://msdn.microsoft.com/en-us/library/office/aa194915(v=office.10).aspx
            wbNew.Close
            ThisWorkbook.Activate
            r = r + 1
        Loop
    
        Application.DisplayAlerts = True
    
    End Sub
    

提交回复
热议问题