IMPORTING 100 TEXT FILES INTO EXCEL AT ONCE, WITH LABELLING

[luis]

Dear all,

I need to import 100 TXT files into a single excel file for my Ph. D.
Dissertation.
All the files have the same structure: only 1 column with 60 rows each,

like this:


01 - I
02 - C
03 - C
60 - I


I'd need to end up with an excel file that included 100 columns, one
for each file, and the name of the corresponding file on top of each
column, like this:


File1 File2 File100
01 - I 01 - C 01 - C
02 - C 02 - I 02 - I
03 - C 03 - C 03 - I
60 - I 60 - C 60 - I


I have little Excel experience, but I know how to paste code into a
module in the Visual Basic Editor. Please find below the code I get if
I import 1 single file into my Excel Workbook, in case it helps.


YOUR HELP WILL BE GREATLY APPRECIATED!!!


THANK YOU!!!!!!!!!!!!!!!!!!!!! ;-D


Luis


*** CODE AFTER IMPORTING 1 TXT FILE ***


Sub importTextFile()
'
' importTextFile Macro
' Macro recorded 08/04/2006 by luis cerezo ceballos
'


'
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\aaqpresults\cerezo-int2-dah38-exp-rel.txt",
Destination:=Range("A1") _
)
.Name = "cerezo-int2-dah38-exp-rel"
.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 = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub

 

[Tom Ogilvy]

Assuming all the text files are in a folder/directory and nothing else is in
there with a .TxT extension

Sub GetFiles()
Dim sPath as String, sName as String
Dim i as Long, qt as QueryTable
With ThisWorkbook
.Worksheets.Add After:= _
.Worksheets(.Worksheets.Count)
End With
Activesheet.Name = Format(Now,"yyyymmdd_hhmmss")
sPath = "C:\aaqpresults\"
sName = dir(sPath & "*.txt")
i = 0
do while sName <> ""
i = i + 1
cells(1,i).Value = sName
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & sPath & sName, Destination:=cells(2,i))
.Name = Left(sName,len(sName)-4)
.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 = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
sName = Dir()
For Each qt In ActiveSheet.QueryTables
qt.Delete
Next
Loop
End Sub

 

[Ron de Bruin]

You can try this one luis for all txt files in C:\Data

Sub Tester()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim Colnum As Long
Dim SourceCcount As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String

SaveDriveDir = CurDir
MyPath = "C:\Data"
ChDrive MyPath
ChDir MyPath

FNames = Dir("*.txt")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If

Application.ScreenUpdating = False
Set basebook = ThisWorkbook
basebook.Worksheets(1).Cells.Clear
'clear all cells on the first sheet
Colnum = 1

Do While FNames <> ""
Workbooks.OpenText FNames, Origin:=xlWindows, StartRow _
:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False, _
Space:=False, Other:=False
Set mybook = ActiveWorkbook

basebook.Worksheets(1).Cells(1, Colnum).Value = mybook.Name
Set sourceRange = mybook.Worksheets(1).Range("A1:A60")
SourceCcount = sourceRange.Columns.Count
Set destrange = basebook.Worksheets(1).Cells(2, Colnum)

sourceRange.Copy destrange
mybook.Close False
Colnum = Colnum + SourceCcount
FNames = Dir()
Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub

 

[Ron de Bruin]

Oops

It will copy to the first sheet of the workbook with this code in this example

 

[luis]

hey Tom!!!

THANK YOU SO MUCH!!!

I just tried your macro and it works great!!!

I'm so happy!!!!

You really helped me.

THANK YOU!!!!!

Have a nice day,

Luis

 

[luis]

hi Ron,

Thank you so much for your reply. I tried Tom's macro above and it
works great, but I just wanted to thank you personally for your kind
help as well.

Have a great day,

Luis