Home |
Search |
Today's Posts |
#2
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
If you want each txt file in another column Try this example
Change the folder in this code line in the macro 'Fill in the path\folder where the files are MyPath = "C:\Users\Ron\test" This example copy 2000 cells Sub Example() Dim MyPath As String, FilesInPath As String Dim MyFiles() As String Dim SourceCcount As Long, Fnum As Long Dim mybook As Workbook, BaseWks As Worksheet Dim sourceRange As Range, destrange As Range Dim Cnum As Long, CalcMode As Long 'Fill in the path\folder where the files are MyPath = "C:\Users\Ron\test" 'Add a slash at the end if the user forget it If Right(MyPath, 1) < "\" Then MyPath = MyPath & "\" End If 'If there are no txt files in the folder exit the sub FilesInPath = Dir(MyPath & "*.txt") If FilesInPath = "" Then MsgBox "No files found" Exit Sub End If 'Fill the array(myFiles)with the list of txt files in the folder Fnum = 0 Do While FilesInPath < "" Fnum = Fnum + 1 ReDim Preserve MyFiles(1 To Fnum) MyFiles(Fnum) = FilesInPath FilesInPath = Dir() Loop 'Change ScreenUpdating, Calculation and EnableEvents With Application CalcMode = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False .EnableEvents = False End With 'Add a new workbook with one sheet Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1) Cnum = 1 'Loop through all files in the array(myFiles) If Fnum 0 Then For Fnum = LBound(MyFiles) To UBound(MyFiles) Set mybook = Nothing On Error Resume Next Workbooks.OpenText Filename:=MyPath & MyFiles(Fnum), Origin:=xlWindows, StartRow _ :=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _ ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=True, _ Space:=False, Other:=False Set mybook = ActiveWorkbook On Error GoTo 0 If Not mybook Is Nothing Then On Error Resume Next Set sourceRange = mybook.Worksheets(1).Range("A1:A2000") If Err.Number 0 Then Err.Clear Set sourceRange = Nothing Else 'if SourceRange use all rows then skip this file If sourceRange.Rows.Count = BaseWks.Rows.Count Then Set sourceRange = Nothing End If End If On Error GoTo 0 If Not sourceRange Is Nothing Then SourceCcount = sourceRange.Columns.Count If Cnum + SourceCcount = BaseWks.Columns.Count Then MsgBox "Sorry there are not enough columns in the sheet" BaseWks.Columns.AutoFit mybook.Close savechanges:=False GoTo ExitTheSub Else 'Copy the file name in the first row With sourceRange BaseWks.Cells(1, Cnum). _ Resize(, .Columns.Count).Value = MyFiles(Fnum) End With 'Set the destrange Set destrange = BaseWks.Cells(2, Cnum) 'we copy the values from the sourceRange to the destrange With sourceRange Set destrange = destrange. _ Resize(.Rows.Count, .Columns.Count) End With destrange.Value = sourceRange.Value Cnum = Cnum + SourceCcount End If End If mybook.Close savechanges:=False End If Next Fnum BaseWks.Columns.AutoFit End If ExitTheSub: 'Restore ScreenUpdating, Calculation and EnableEvents With Application .ScreenUpdating = True .EnableEvents = True .Calculation = CalcMode End With End Sub -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "jeffg11" wrote in message ... How can i import up to 100 files into the same spreadsheet from: Filename1.txt Freq [Hz] dBSPL Phase [Deg] 20.00 116.25 -101.80 20.56 115.78 -73.43 21.13 115.11 -46.75 21.71 113.43 -10.13 22.32 111.14 11.57 22.94 107.99 12.61 23.58 104.44 -0.59 24.23 103.51 -17.97 Filename2.txt Freq [Hz] dBSPL Phase [Deg] 20.00 114.85 -87.46 20.56 114.33 -114.88 21.13 113.59 -138.83 21.71 111.82 -170.68 22.32 109.53 169.09 22.94 106.39 154.78 23.58 103.27 138.49 24.23 102.07 127.61 ETC... when done the final spreadsheet looks like this. Freq [Hz] Filename1 Filename2 Filename3 20 116.25 114.85 112.32 20.56 115.78 114.33 111.84 21.13 115.11 113.59 111.17 21.71 113.43 111.82 109.62 22.32 111.14 109.53 107.61 22.94 107.99 106.39 105.03 23.58 104.44 103.27 102.69 24.23 103.51 102.07 101.7 |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Importing Multiple Text Files | Excel Programming | |||
Importing multiple text files to worksheets | Excel Programming | |||
Importing multiple files into spreadsheet | Excel Programming | |||
Importing from multiple text files | Excel Programming | |||
importing multiple text files??? | Excel Discussion (Misc queries) |