Convert Excel columns to csv data - excel

Question

I would like each column of an Excel sheet to become a CSV file having just that column as its only line.
Example, from the attached Excel screenshot my output should be two csv files (because of the 2 columns) with one row each.
That is the first csv variables will be from 1-9, while the second will be from 11-19.

Answer 1

Export Column To Row
Exports each column of a range to one-row .csv-file.
Adjust the values in the constants section.
Option Explicit
Sub exportColumnsToCSV()
Const FolderPath As String = "F:\Test\2021\66730122\"
Const FileLeft As String = "File "
Const csvDelimiter As String = "," ' or maybe ";"
Dim rg As Range: Set rg = Range("A1").CurrentRegion
Dim Data As Variant: Data = rg.Value
Dim rCount As Long: rCount = UBound(Data, 1)
Dim Result As Variant: ReDim Result(1 To rCount)
Dim cNum As Long: cNum = FreeFile
Dim cFile As String
Dim c As Long, r As Long
For c = 1 To UBound(Data, 2)
For r = 1 To rCount
Result(r) = Data(r, c)
Next r
cFile = FolderPath & FileLeft & c & ".csv"
Open cFile For Output As #cNum
Print #cNum, Join(Result, csvDelimiter)
Close #cNum
Next c
End Sub

Answer 2

You're lucky, I just spent my week on a similar problem. I adapted it to your problem.
Enjoy!
Private Sub SplitColumnsInCSV()
Dim wb As Workbook
Dim ws As Worksheet
Dim TableToSplit As ListObject
Dim WorkbookPath As String
Dim CSVLocation As String
Dim FilePath As String
Dim Folder As String
Dim i, j, TableColumnCount As Integer
Dim TempRangeToSplit As Range
Set wb = ActiveWorkbook
'Real name of your worksheet where your table is located
Set ws = wb.Worksheets("Feuil1")
'Real name of your table in your worksheet
Set TableToSplit = ws.ListObjects("TableToSplit")
For i = 1 To TableToSplit.ListColumns.Count
'adjust temp range for each columns
Set TempRangeToSplit = TableToSplit.ListColumns(i).Range
'Create à folder with your CSV where your workbook is located
CSVLocation = wb.Path & "\CSV\"
Folder = Dir(CSVLocation, vbDirectory)
If Folder = "" Then MkDir CSVLocation
'name the csv file
FilePath = wb.Path & "\CSV\" & ws.Name & TempRangeToSplit.Cells(1, 1).Value & ".csv"
'this piece of code have 2 loops in case of 2 dimentionnal range
Open FilePath For Output As #1
For j = 1 To TempRangeToSplit.Rows.Count
For k = 1 To TempRangeToSplit.Columns.Count
cellValue = TempRangeToSplit.Cells(j, k).Value
If k = TempRangeToSplit.Columns.Count Then
Write #1, cellValue
Else
Write #1, cellValue,
End If
Next k
Next j
Close #1
Next i
End Sub
In detail:
I fill the temp range with the column I want to extract in CSV
I create a folder in case it doesn't already exist
I create the csv file and give it a name
I write in the csv file all the lines of a column
Be careful, if you reuse the macro, the new files with the same name will overwrite the old ones.