Opening CSV-files as new sheets in current workbook

[jonasste]

Hi!

This is my first post to this forum. My code is currently working fine. It allows the user to select multiple CSV-files from a folder and it imports them into seperate sheets in a new workbook. I would like it to import it as new sheets into the workbook the code is run from. I guess it's an easy tweak, but i can't figure it out!

I not sure how much of the code you will need so i'll just post the whole thing. Sorry if it is a bit messy!

[vba] 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:="Text Files (*.csv), *.csv", _
MultiSelect:=True, Title:="Text 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

Range("A1").Value = Right(Range("A1").Value, Len(Range("A1").Value) - 29)
ActiveSheet.Name = Range("A1").Value

While x <= UBound(FilesToOpen)
Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
Range("A1").Value = Right(Range("A1").Value, Len(Range("A1").Value) - 29)
ActiveSheet.Name = Range("A1").Value
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
[/vba]

[CodeNinja]

How about something like this:

[vba]Sub CombineTextFiles()
Dim FilesToOpen
Dim x As Integer
Dim wkbAll As Workbook
Dim wkbTemp As Workbook
Dim sDelimiter As String
Dim newSheet As Worksheet

On Error GoTo ErrHandler
Application.ScreenUpdating = False

sDelimiter = ","

FilesToOpen = Application.GetOpenFilename _
(FileFilter:="Text Files (*.csv), *.csv", _
MultiSelect:=True, Title:="Text Files to Open")

If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "No Files were selected"
GoTo ExitHandler
End If

For x = 1 To UBound(FilesToOpen)

Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
'wkbTemp.Sheets(1).Copy
wkbTemp.Sheets(1).Cells.Copy
' here you just want to create a new sheet and paste it to that sheet
Set newSheet = ThisWorkbook.Sheets.Add
With newSheet
.Name = wkbTemp.Name
.PasteSpecial
End With
Application.CutCopyMode = False
wkbTemp.Close
Next x


ExitHandler:
Application.ScreenUpdating = True
Set wkbAll = Nothing
Set wkbTemp = Nothing
Exit Sub

ErrHandler:
MsgBox Err.Description
Resume ExitHandler

End Sub[/vba]

[jonasste]

Thanks for the reply. I ended up with doing the code all over again, now it works!

[jonasste]

Hi again!

I thought i had the code working perfectly, however there's a small problem.

When opening csv-files in excel the program will automatically split the text into columns if the file has semicolon as text seperator. If the files has comma as seperator Excel won't be able to automatically split the file.

In my code i experience the exact opposite! If i open text files with comma as text separator it will split it just fine, if I open files with semicolon as separator it doesn't work!

I need it to work with files with semicolon as text separator (beacuse of the program that generates the text files). Can anyone please have a look at my code? I really need this to work now that everything else works just fine (this code is only a small part of the codes in my workbook)!

My code (sorry for the Norwegian variable names!):
[vba]Sub Importer_Filer()

Dim Filer
Dim MidlertidigBok As Workbook
Dim TagNavn As String

Application.DisplayAlerts = False

On Error GoTo ErrHandler

Filer = Application.GetOpenFilename _
(FileFilter:="Text Files (*.csv), *.csv", _
MultiSelect:=True, Title:="Velg filer")

If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "Ingen filer valgt!"
GoTo ExitHandler
End If


For n = 1 To UBound(Filer)

Set MidlertidigBok = Workbooks.Open(Filename:=Filer(n))
Cells.Copy

ThisWorkbook.Activate
Sheets.Add after:=Worksheets(Worksheets.Count)
Range("A1").Select
ActiveSheet.Paste

Range("A1").Value = Right(Range("A1").Value, Len(Range("A1").Value) - 29)
ActiveSheet.Name = Range("A1").Value
Cells.Select
Selection.Columns.AutoFit
Range("A1").Select

MidlertidigBok.Close

Next n

Sheets(1).Select

ExitHandler:
Exit Sub

ErrHandler:
MsgBox Err.Description
Resume ExitHandler

End Sub[/vba]

[Teeroy]

First you need to change FilesToOpen to Filer in the TypeName() test for the error handling to work correctly.

Second, and this is untested, how about trying to replace
[VBA]Set MidlertidigBok = Workbooks.Open(Filename:=Filer(n))[/VBA]
with
[VBA]Set MidlertidigBok = Workbooks.Open(Filename:=Filer(n), Delimiter:=",")[/VBA]

[snb]

[vba]Sub Importer_Filer()
For each fl in Application.GetOpenFilename ("Text Files (*.csv), *.csv", , "Velg filer",,True)
With workbooks.open(fl)

.sheets(1).move thisworkbook.sheets(1)

.close false
End with

Next

End Sub[/vba]

The tags are making a mess of this code.

Sub Importer_Filer()
For each fl in Application.GetOpenFilename ("Text Files (*.csv), *.csv", , "Velg filer",,True)
With workbooks.open(fl)

.sheets(1).move thisworkbook.sheets(1)

.close false
End with

Next

End Sub

[jonasste]

I managed to fix the code myself. But thanks for all help anyway!