insert multiple csv files into multiple workshee

Topic

New Reply

I have three .csv files that need to be programmatically converted into one excel spreadsheet with a tab for each file. Can you help me?

Thanks

Reply | Quote

Replies

Hi Melanie
I have some code around here somewhere (rummage, rummage)
I get back to you when I find it.

Reply | Quote

Caution – this is from 2003, so you’ll probably want to update it.

Code:

Attribute VB_Name = "LargeTextImport"
Option Base 1
Sub PlusSizeColumnImport()
Dim SheetName As String
Dim FileWithData As Variant
Dim NumColumns, NumRows, Counter, Counter1, Counter2, NumSheets, SCount, SheetCounter, NxtSheet As Integer
Dim myArray() As Variant
Dim ActColumn(2), SkpColumn(4)
Dim OpeningMsg, Style, Title, Reponse As String

'opening Message
OpeningMsg = "Do you wish to import a tab delimited text file?" & Chr(13) & Chr(13) & _
"This file can have more than 256 Columns, but can not have more than 65,536 rows." & Chr(13) & _
"Maximum columns is 64,000. A new file will be opened for the data"
Style = vbOKCancel
Title = "Do you wish to proceed?"
response = MsgBox(OpeningMsg, Style, Title)
If response = vbOK Then
	GoTo Start
Else
	GoTo Finish
End If

Start:
'locate file with information
FileWithData = Application.GetOpenFilename("Text Files (*.txt), *.txt")
If FileWithData  False Then
' make field for connection
	FileWithData = "TEXT;" & FileWithData
End If

'Get dimensions of file to import
NumColumns = Application.InputBox("How many columns are in this file?", "Enter Columns", , , , , , 1)
'open new workbook
Workbooks.Add
'count the number of sheets necessary in the workbook
'this will place up to 250 columns on a sheet
NumSheets = Application.WorksheetFunction.RoundUp(NumColumns / 250, 0)
SCount = Worksheets.Count
'add more sheets if neccessary
Counter = NumSheets - SCount
If Counter > 0 Then
	For Counter2 = 1 To Counter
 	Worksheets.Add after:=Sheets(Sheets.Count)
	Next Counter2
	Sheets("Sheet1").Select
End If
'set values for active column start range ActColumn(1) and end range ActColumn(2). ActColumn(1)
'is negative at this point because it will be incremented later on.
ActColumn(1) = -249
ActColumn(2) = 0

'counting from 1 to total number of sheets
For SheetCounter = 1 To NumSheets
'increment active column range for each sheet
ActColumn(1) = ActColumn(1) + 250
ActColumn(2) = ActColumn(2) + 250

'sets the end of the active column range to be no greater than the total number of columns
If ActColumn(2) > NumColumns Then
 ActColumn(2) = NumColumns
End If

'set the inactive column ranges, on the first pass SkpColumn(1) and SkpColumn(2) will be inactive
SkpColumn(1) = ActColumn(1) - 250
SkpColumn(2) = ActColumn(1) - 1
SkpColumn(3) = ActColumn(2) + 1
SkpColumn(4) = NumColumns

'sets the first skipped column value to be no greater than 1
If SkpColumn(1) > 1 Then
 SkpColumn(1) = 1
End If

'create array for textfileimport
'set the size of the array to equal the number of columns
ReDim myArray(NumColumns)
'In MyArray set the active column values to 1 and skipped columns to 9, then the MyArray is used
'the QueryTable section that follows.
For Counter1 = ActColumn(1) To ActColumn(2)
	myArray(Counter1) = 1
Next Counter1
If SkpColumn(3)  0 Then
	For Counter1 = SkpColumn(1) To SkpColumn(2)
 	myArray(Counter1) = 9
	Next Counter1
End If
'QueryTable import
	With ActiveSheet.QueryTables.Add(Connection:=FileWithData, Destination:=Range("B1"))
 	.Name = ImportRangeName
 	.FieldNames = True
 	.RowNumbers = False
 	.FillAdjacentFormulas = False
 	.PreserveFormatting = True
 	.RefreshOnFileOpen = False
 	.RefreshStyle = xlInsertDeleteCells
 	.SavePassword = False
 	.SaveData = True
 	.AdjustColumnWidth = True
 	.RefreshPeriod = 0
 	.TextFilePromptOnRefresh = False
 	.TextFilePlatform = xlWindows
 	.TextFileStartRow = 1
 	.TextFileParseType = xlDelimited
 	.TextFileTextQualifier = xlTextQualifierDoubleQuote
 	.TextFileConsecutiveDelimiter = False
 	.TextFileTabDelimiter = True
 	.TextFileSemicolonDelimiter = False
 	.TextFileCommaDelimiter = False
 	.TextFileSpaceDelimiter = False
 	.TextFileColumnDataTypes = Array(myArray)
 	.Refresh BackgroundQuery:=False
	End With
'This deletes the first name in the workbook THERE SHOULDN'T BE ANY NAMES IN AN EMPTY WORKBOOK!
	ActiveWorkbook.Names(1).Delete
	If NxtSheet < NumSheets Then
 	NxtSheet = SheetCounter + 1
 	SheetName = "Sheet" & NxtSheet
 	Sheets(SheetName).Select
	End If
Next SheetCounter

Finish:
End Sub

This doesn't do the job completely – but should give you a launching point.

Reply | Quote

Awesome! Thank you!

Reply | Quote