Importing multiple CSV to multiple worksheet in a single workbook

This guy absolutely nailed it. Very concise code and works perfectly for me on 2010. All credit goes to him (Jerry Beaucaire). I found it from a forum here.

Option ExplicitSub ImportCSVs()'Author:    Jerry Beaucaire'Date:      8/16/2010'Summary:   Import all CSV files from a folder into separate sheets'           named for the CSV filenames'Update:    2/8/2013   Macro replaces existing sheets if they already exist in master workbookDim fPath   As StringDim fCSV    As StringDim wbCSV   As WorkbookDim wbMST   As WorkbookSet wbMST = ThisWorkbookfPath = "C:\test\"                  'path to CSV files, include the final \Application.ScreenUpdating = False  'speed up macroApplication.DisplayAlerts = False   'no error messages, take default answersfCSV = Dir(fPath & "*.csv")         'start the CSV file listing    On Error Resume Next    Do While Len(fCSV) > 0        Set wbCSV = Workbooks.Open(fPath & fCSV)                    'open a CSV file        wbMST.Sheets(ActiveSheet.Name).Delete                       'delete sheet if it exists        ActiveSheet.Move After:=wbMST.Sheets(wbMST.Sheets.Count)    'move new sheet into Mstr        Columns.Autofit             'clean up display         fCSV = Dir                  'ready next CSV    LoopApplication.ScreenUpdating = TrueSet wbCSV = NothingEnd Sub

Beware, this does not handles errors like you would have a duplicate sheet name if you imported a csv.

This uses early binding so you need to Reference Microsoft.Scripting.Runtime under Tools..References in the VBE

Dim fs  As New FileSystemObjectDim fo As FolderDim fi As FileDim wb As WorkbookDim ws As WorksheetDim sname As StringSub loadall()    Set wb = ThisWorkbook    Set fo = fs.GetFolder("C:\TEMP\")    For Each fi In fo.Files        If UCase(Right(fi.name, 4)) = ".CSV" Then            sname = Replace(Replace(fi.name, ":", "_"), "\", "-")            Set ws = wb.Sheets.Add            ws.name = sname            Call yourRecordedLoaderModified(fi.Path, ws)        End If    NextEnd SubSub yourRecordedLoaderModified(what As String, where As Worksheet)With ws.QueryTables.Add(Connection:= _    "TEXT;" & what, Destination:=Range("$A$1"))    .name = "test1"    .FieldNames = True    .RowNumbers = False    .FillAdjacentFormulas = False    .PreserveFormatting = True    .RefreshOnFileOpen = False    .RefreshStyle = xlInsertDeleteCells    .SavePassword = False    .SaveData = True    .AdjustColumnWidth = True    .RefreshPeriod = 0    .TextFilePromptOnRefresh = False    .TextFilePlatform = 437    .TextFileStartRow = 1    .TextFileParseType = xlDelimited    .TextFileTextQualifier = xlTextQualifierDoubleQuote    .TextFileConsecutiveDelimiter = False    .TextFileTabDelimiter = False    .TextFileSemicolonDelimiter = False    .TextFileCommaDelimiter = True    .TextFileSpaceDelimiter = False    .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1)    .TextFileTrailingMinusNumbers = True    .Refresh BackgroundQuery:=FalseEnd WithSheets.Add After:=Sheets(Sheets.Count)End Sub

You can use Dir to filter out and run with just the csv files

Sub MacroLoop()Dim strFile As StringDim ws As WorksheetstrFile = Dir("c:\test\*.csv")Do While strFile <> vbNullStringSet ws = Sheets.AddWith ws.QueryTables.Add(Connection:= _    "TEXT;" & "C:\test\" & strFile, Destination:=Range("$A$1"))    .Name = strFile    .FieldNames = True    .RowNumbers = False    .FillAdjacentFormulas = False    .PreserveFormatting = True    .RefreshOnFileOpen = False    .RefreshStyle = xlInsertDeleteCells    .SavePassword = False    .SaveData = True    .AdjustColumnWidth = True    .RefreshPeriod = 0    .TextFilePromptOnRefresh = False    .TextFilePlatform = 437    .TextFileStartRow = 1    .TextFileParseType = xlDelimited    .TextFileTextQualifier = xlTextQualifierDoubleQuote    .TextFileConsecutiveDelimiter = False    .TextFileTabDelimiter = False    .TextFileSemicolonDelimiter = False    .TextFileCommaDelimiter = True    .TextFileSpaceDelimiter = False    .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1)    .TextFileTrailingMinusNumbers = True    .Refresh BackgroundQuery:=FalseEnd WithstrFile = DirLoopEnd Sub