Merge Functions‎ > ‎

CSVs to Columns

"I need to extract cells E2,4,7,8,9,10,13,14,15,18,30,40,41,42,43,45 from 100-plus CSV files
to one sheet inserting into a new column for each CSV file.  All CSV files are in one folder,
but naming convention may vary."

  1. All CSV files in one folder
  2. CSV file names vary
  3. Copy specific cells from the each CSV into a separate column for each file
  4. Add CSV name to the top of each column
  5. Code to edit is highlighted


Option Explicit

Sub ImportManyCSVIntoColumns()
'Author:    Jerry Beaucaire
'Date:      6/17/2010
'Summary:   In a specific folder, import key cells from all CSV files

Dim fPath   As String:      fPath = "C:\2010\"
Dim fCSV    As String
Dim fRNG    As String:      fRNG = "E2,E4,E7:E10,E13:E15,E18,E30,E40,E41,E42,E43,E45"
Dim oldDir  As String
Dim wsTrgt  As Worksheet:   Set wsTrgt = ThisWorkbook.Sheets("Sheet1")
Dim wbCSV   As Workbook
Dim NxtCol  As Long
Application.ScreenUpdating = False

NxtCol = wsTrgt.Cells(1, wsTrgt.Columns.Count).End(xlToLeft).Column + 1
oldDir = CurDir
ChDir fPath

fCSV = Dir("*.csv")

    Do While Len(fCSV) > 0
        wsTrgt.Cells(1, NxtCol) = Replace(fCSV, ".csv", "")
        Set wbCSV = Workbooks.Open(fCSV)
        Range(fRNG).Copy wsTrgt.Cells(2, NxtCol)
        NxtCol = NxtCol + 1
        wbCSV.Close False
        fCSV = Dir
ChDir oldDir
Application.ScreenUpdating = True
End Sub

Nothing says "thanks" like a steak dinner!
PayPal - The safer, easier way to pay online!