VBA to import multiple CSV files into multiple sheets in excel - vba

Question

I am working to make an automated template that imports multiple csv files into multiple sheets in an excel template that I have created.
So far I have one sheet in the template that has a table named Results and a column named Login ID. I wrote the following script to automatically create sheets and name them. My table data starts on row 7.
Sub Prepare_Report()
Dim WS As Worksheet
' Go to the results page
Sheets("Results Page").Select
' Create all additional sheets from Login ID field in the results table
Dim N As Long, I As Long
N = Range("Results[Login ID]").Rows.Count + 6
For I = 7 To N
aName = Worksheets("Results Page").Range("C" & I).Value
Set WS = Sheets.Add(After:=Sheets(Worksheets.Count))
WS.Name = aName
Next I
Each CSV file I have to import is named after one of the Login ID's as well, and they will be located in the same folder as the template I am creating.
the CSV files will need a slight modification to separate the date and time from the first column.
' Columns("A:A").Select
' Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
' Columns("B:B").Select
' Selection.Cut Destination:=Columns("A:A")
' Columns("A:A").Select
' Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
' FieldInfo:=Array(Array(0, 1), Array(10, 1)), TrailingMinusNumbers:=True
' Columns("A:A").Select
' Selection.NumberFormat = "mm/dd/yy;#"
' Columns("B:B").Select
' Columns("B:B").EntireColumn.AutoFit
'
Any ideas if I am on the right track or how to best solve my CSV import woes would be much appreciated.

Answer 1

This will do what you want!
Sub CombineTextFiles()
Dim FilesToOpen
Dim x As Integer
Dim wkbAll As Workbook
Dim wkbTemp As Workbook
Dim sDelimiter As String
On Error GoTo ErrHandler
Application.ScreenUpdating = False
sDelimiter = "|"
FilesToOpen = Application.GetOpenFilename _
(FileFilter:="CSV Files (*.csv), *.csv", _
MultiSelect:=True, Title:="CSV Files to Open")
If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "No Files were selected"
GoTo ExitHandler
End If
x = 1
Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
wkbTemp.Sheets(1).Copy
Set wkbAll = ActiveWorkbook
wkbTemp.Close (False)
wkbAll.Worksheets(x).Columns("A:A").TextToColumns _
Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=False, Semicolon:=False, _
Comma:=False, Space:=False, _
Other:=True, OtherChar:="|"
x = x + 1
While x <= UBound(FilesToOpen)
Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
With wkbAll
wkbTemp.Sheets(1).Move After:=.Sheets(.Sheets.Count)
.Worksheets(x).Columns("A:A").TextToColumns _
Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=False, Semicolon:=False, _
Comma:=False, Space:=False, _
Other:=True, OtherChar:=sDelimiter
End With
x = x + 1
Wend
ExitHandler:
Application.ScreenUpdating = True
Set wkbAll = Nothing
Set wkbTemp = Nothing
Exit Sub
ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub