Navid
Navid

Reputation: 245

Copy rows from csv into columns in new worksheet

I want to:
1- retrieve all csv files in a folder.
2- put the file names in the first row of a new worksheet.
3- copy all the column titles (first row) from the csv files.
4- paste them in one column under each file name in a new worksheet.

I know I need to use range but I am confused how to use it.

This is what I have done to get the csv files. I have problems with copying the rows into columns:

Dim CSVPath
Dim FS
Dim file
Dim wkb As Excel.Workbook
Dim ResultsSheet As Worksheet
Dim RowPtr As Range
Dim CSVUsed As Range

Set ResultsSheet = Sheet1

'Clear the results sheet
ResultsSheet.Cells.Delete

Set FS = CreateObject("Scripting.FileSystemObject")

'The CSV files are stored in a "CSV" subfolder of the folder where
'this workbook is stored.
CSVPath = ThisWorkbook.Path & "\CSV"

If Not FS.FolderExists(CSVPath) Then
    MsgBox "CSV folder does not exist."
    Exit Sub
End If

For Each file In FS.GetFolder(CSVPath).Files
    If Right(file.Name, 3) = "csv" Then 'Only look at files with .csv extension
        Set wkb = Application.Workbooks.Open(file.Path)
Next

Also I know the loop should be something like this:

FinalRow = Cells(Rows.Count, 1).End(xlUp).Row 
For x = 2 To FinalRow 

Upvotes: 1

Views: 1777

Answers (2)

William Humphries
William Humphries

Reputation: 568

I found this article to open and read from a text/csv file and then looped through all items in the string/variant to add to the Excel sheet.

VBA code is below

Sub FillInExcelFromCSV(tempCSV As String, tempXL As String, rowToFill As Integer)

Dim i, counter As Integer
Set tempFile = GetObject(tempCSV)
Set tempXLFile = GetObject(tempXL)
row_number = 1

Open tempCSV For Binary As #1
  Do Until EOF(1)
    Line Input #1, LineFromFile
    LineItems = Split(LineFromFile, ",") 'Gets data from CSV
    counter = 1
    For Each csvVal In LineItems
        Debug.Print (csvVal)
        tempXLFile.Worksheets("Sheet1").Cells(rowToFill, counter).Value = csvVal
        counter = counter + 1
    Next
    row_number = row_number + 1
    Exit Do
  Loop
Close #1
End Sub

Sub vbaTest()
  Call FillInExcelFromCSV("C:\dataFrom.csv","C:\dataTo.xlsx", 5)
End Sub

Upvotes: 0

johnzilla
johnzilla

Reputation: 336

Try something like:

Dim wb1 As Workbook, wb2 As Workbook
Dim colnum
Dim arr1
Dim range2 As Range

colnum = 20
Set wb2 = ThisWorkbook

Set range2 = wb2.Worksheets("Sheet1").Range("A1")   'wherever I want to paste my data to
For Each file In fs.getfolder(CSVPath).file
       If Right(file.Name, 3) = "csv" Then
            Set wb1 = Application.Workbooks.Open(file.Path)
            arr1 = wb1.Worksheets("WHATEVER_ITS_NAME_IS").Range("A1").resize(1, colnum).Value
            rowlen = UBound(arr1, 1) - LBound(arr1, 1) + 1
            collen = UBound(arr1, 2) - LBound(arr1, 2) + 1

            range2.Resize(rowlen, collen).Value = arr1
        End If
Next

There's lots of ways to skin this cat. Not sure if my code works but maybe this will help. Usually I don't like to loop through every cell. In VBA, these sort of loops are very slow. It's better to just copy the whole array at once. Use the property Range.Value to set/get the array data from the Range object

Upvotes: 2

Related Questions