Merge all CSV or TXT files as One Worksheet

This code will ask you to browse to the folder with the csv files and after you click OK in this dialog
it merge all data into a txt file and then import and save it into a Excel file for you.

Copy the code below into a normal module of a workbook :

Alt-F11
Insert>Module
Paste the macro
Alt q to go back to Excel
Alt F8 to open your macro list
Select Merge_CSV_Files and press Run

Part 1 - Imported Data is Stacked

Additional files are attached under the same column.

CODE

Option Explicit

Sub ImportCSVsWithReference()
'Author:    Jerry Beaucaire
'Date:      10/16/2010
'Summary:   Import all CSV files from a folder into a single sheet
'           adding a field in column A listing the CSV filenames
Dim wbCSV   As Workbook
Dim wsMstr  As Worksheet:   Set wsMstr = ThisWorkbook.Sheets("MasterCSV")
Dim fPath   As String:      fPath = "C:\2010\Import\"    'path to CSV files, include the final \
Dim fCSV    As String

If MsgBox("Clear the existing MasterCSV sheet before importing?", vbYesNo, "Clear?") _
    = vbYes Then wsMstr.UsedRange.Clear

Application.ScreenUpdating = False  'speed up macro

fCSV = Dir(fPath & "*.csv")         'start the CSV file listing

    Do While Len(fCSV) > 0
      'open a CSV file        Set wbCSV = Workbooks.Open(fPath & fCSV)
      'insert col A and add CSV name        Columns(1).Insert xlShiftToRight
        Columns(1).SpecialCells(xlBlanks).Value = ActiveSheet.Name
      'copy date into master sheet and close source file        ActiveSheet.UsedRange.Copy wsMstr.Range("A" & Rows.Count).End(xlUp).Offset(1)
        wbCSV.Close False
      'ready next CSV        fCSV = Dir
    Loop

Application.ScreenUpdating = True
End Sub

---

 Part 2 - Imported Data is side by side imported into adjacent columns
 Additional files are attached in new side column.

CODE

Option Explicit

Sub ImportCSVsWithReference()
'Author:    Jerry Beaucaire
'Date:      11/3/2011
'Summary:   Import all CSV files from a folder into a single sheet
'           adding a field in row 1 for listing the CSV filenames
Dim wbCSV   As Workbook
Dim wsMstr  As Worksheet:   Set wsMstr = ThisWorkbook.Sheets("MasterCSV")
Dim fPath   As String:      fPath = "C:\2010\Import\"    'path to CSV files, include the final \
Dim fCSV    As String
Dim NextCol As Long

If MsgBox("Clear the existing MasterCSV sheet before importing?", _
    vbYesNo, "Clear?") = vbYes Then
        wsMstr.UsedRange.Clear
        NextCol = 1
Else
        NextCol = wsMstr.Cells(3, Columns.Count).End(xlToLeft).Column + 1
End If

Application.ScreenUpdating = False  'speed up macro

fCSV = Dir(fPath & "*.csv")         'start the CSV file listing

    Do While Len(fCSV) > 0
      'open a CSV file
        Set wbCSV = Workbooks.Open(fPath & fCSV)
      'insert row 1 and add CSV name
        Rows(1).Insert xlShiftDown
        Range("A1") = ActiveSheet.Name
      'copy date into master sheet and close source file
        ActiveSheet.UsedRange.Copy wsMstr.Cells(1, NextCol)
        wbCSV.Close False
      'ready next CSV
        fCSV = Dir
        NextCol = wsMstr.Cells(3, Columns.Count).End(xlToLeft).Column + 1
    Loop

Application.ScreenUpdating = True
End Sub

---

Share on Google Plus

About Unknown