Macro to create new files

[btrotter]

I have a .csv file with a single column of data. I want to create a separate
..csv file for each cell in the column utilizing a macro since there are over
600 cells in the row. Any advice on how to create this macro to automate the
process?

Thanks in advance.

 

[btrotter]

Sorry - make that 600 cells in the column.

 

[Dave Peterson]

So you want each value in it's own .csv file?

Option Explicit
Sub testme()

Dim FileNum As Long
Dim myRng As Range
Dim myCell As Range

With Worksheets("sheet1")
Set myRng = .Range("a1", .Cells(.Rows.Count, "A").End(xlUp))
End With

FileNum = FreeFile
Close #FileNum

For Each myCell In myRng.Cells
Open "C:\temp\" & Format(myCell.Row, "0000") & ".CSV" _
For Output As FileNum
Print #FileNum, myCell.Text
Close #FileNum
Next myCell

End Sub

(Make sure that "C:\temp\" already exists (or change the code to a folder that
does exist.)

 

[Gord Dibben]

You want 600+ csv files with the data from 1 cell in each file?

Assuming you have a C:\mycsv folder

Open the *,csv file in Excel, make sure your data is in Sheet1 then run this
macro.

You can add the macro to the open workbook or to your Personal.xls

Sub Make_New_Books()
Dim rng As Range
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set rng = ActiveSheet.Range(Range("A1"), Range("A" & Rows.Count). _
End(xlUp).Address)
For Each cell In rng
cell.Copy
Workbooks.Add
With ActiveWorkbook
.Sheets("Sheet1").Range("A1").Value = cell.Value
.SaveAs Filename:="C:\mycsv" & "\" & cell.Value, FileFormat:=xlCSV, _
CreateBackup:=False
.Close
End With
Next cell
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub


Gord Dibben MS Excel MVP