Merge Functions‎ > ‎

CSVs to Columns

PROBLEM:
"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."


SPECIFICATIONS:
  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

CODE

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
    Loop
   
ChDir oldDir
Application.ScreenUpdating = True
End Sub




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


Comments