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