ExcelBanter - help with macro to read and sort data from multiple text files

Below I added more comments to previous code and added Constants for sheet
names. if you need help email me at . Explain in detail
the problems. You said previously you had code to due the sorting so I
didn't add any sort code. Just reading of the text files and appending the
sorted data to the sumary sheet.

Send me samples of the text files or the text file data read into sheet1 of
your spreadsheet.

Sub GetTextFiles()
Const MyPath = "D:\temp"
Const ReadWorkSheet = "Sheet1"
Const SortedWorkSheet = "Sheet2"
Const SummaryWorkSheet = "Sheet3"

Set fs = Application.FileSearch
With fs
.LookIn = MyPath
.Filename = "*.txt"
End With

If fs.Execute(SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending) 0 Then

For i = 1 To fs.FoundFiles.Count
With Worksheets(ReadWorkSheet).QueryTables. _
Add(Connection:="TEXT;" + fs.FoundFiles(i), _
Destination:=Worksheets(ReadWorkSheet).Range("A1") )
.Name = fs.FoundFiles(i)
.FieldNames = True
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileCommaDelimiter = True
.TextFileColumnDataTypes = _
Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With

'copy sheet 2
'check row 1 for last ocupied cell
LastColumn2 = Worksheets(SortedWorkSheet). _
Cells(1, Columns.Count).End(xlToLeft).Column
'check column 1 (A) for last row
Lastrow2 = Worksheets(SortedWorkSheet). _
Cells(Rows.Count, 1).End(xlUp).Row

'check row 1 for last occupied column
PasteColumn = Worksheets(SummaryWorkSheet). _
Cells(1, Columns.Count).End(xlToLeft).Column

'add one to paste column except if pasting in column A
If PasteColumn = 1 Then
If Not IsEmpty(Worksheets(SummaryWorkSheet).Cells(1, 1)) Then
PasteColumn = 2
End If
Else
PasteColumn = PasteColumn + 1
End If

'get Range of data on worksheet with sorted data
Worksheets(SortedWorkSheet).Activate
Set CopyRange = Worksheets(SortedWorkSheet). _
Range(Cells(1, 1), Cells(Lastrow2, LastColumn2))

'Paste data to the right of previous data
Set PasteRange = Worksheets(SummaryWorkSheet). _
Cells(1, PasteColumn)

CopyRange.Copy Destination:=PasteRange

'delete pevious data read from text file
Set MyQueryTable = Worksheets(ReadWorkSheet).QueryTables
For j = 1 To (MyQueryTable.Count - 1)
MyQueryTable(j).Delete
Next j

Worksheets(ReadWorkSheet).Activate
Worksheets(ReadWorkSheet).Cells.Select
Selection.ClearContents
Worksheets(ReadWorkSheet).Cells(1, 1).Select

Next i
Else
MsgBox "There were no files found."
End If

End Sub

" wrote:

Joel,

This is regarding my post on " microsoft.public.excel.programming"
3/16/07 with above subject. I am adapting your VBScript to work for
me
but still have some issues that I have not been able to resolve. I
would like to send you my files (.xls, .dat), if you give an email
address, so
you can help me out?

thank you very much for your help

Jay