jonasste
06-28-2012, 12:20 AM
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!
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
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!
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