Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Combine Text Files into One Worksheet
This group is better than any "formal" training a gal could have. I've
learned a lot over the years from you and I have another questions that I know you can help with. I need to combine multiple text files into one worksheet. This should be fairly straight forward, however I just can't get my arms around it. The text files (6 to 8 of them) need to have fixed length columns, with all columns formatted as text to retain leading zeros. The number of rows will most likely end up around 7000 for each text file. The code I have works fine, with a large portion of the various subs coming from this group. However, I don't think it needs to be as complex as it is. A Sub called FormatFiles starts everything off. Sub ImportTextFile brings in the text files and starts off other subs designed to combine the text files into one worksheet. I'm just going to include the subs that actually import the text files and combine them, to prevent this posting from being too long. Can you help me trim this down while still having it function as needed? ======================= Sub ImportTextFile() Dim File As Variant Dim i As Long Dim Book As Workbook File = Application.GetOpenFilename(FileFilter:="Text files (*.txt),*.txt", _ Title:="Select the files to import", MultiSelect:=True) If TypeName(File) = "Boolean" Then Exit Sub Application.ScreenUpdating = False Set Book = Workbooks.Add(xlWorksheet) For i = LBound(File) To UBound(File) ProcessFile WhichFile:=CStr(File(i)), WhichBook:=Book Next i Application.DisplayAlerts = False Book.Sheets(1).Delete Application.DisplayAlerts = True Application.ScreenUpdating = True Call CopyDataWithoutHeaders End Sub ======================= Sub ProcessFile(ByVal WhichFile As String, ByRef WhichBook As Workbook) Dim WS As Worksheet Dim ColumnInformation As Variant ColumnInformation = Array(Array(0, 2), Array(4, 2), Array(10, 2), Array(18, 2), _ Array(22, 2), Array(28, 2), Array(31, 2), Array(36, 2), _ Array(42, 2), Array(51, 2), Array(54, 2)) Workbooks.OpenText Filename:=WhichFile, Origin:=xlWindows, StartRow:=1, _ DataType:=xlFixedWidth, FieldInfo:=ColumnInformation Cells.Select Selection.Columns.AutoFit Range("A1").Select With ActiveSheet .Copy After:=WhichBook.Sheets(WhichBook.Sheets.Count) .Parent.Close SaveChanges:=False End With End Sub ======================= Sub CopyDataWithoutHeaders() Dim sh As Worksheet Dim DestSh As Worksheet Dim Last As Long Dim shLast As Long Dim CopyRng As Range Dim StartRow As Long With Application .ScreenUpdating = False .EnableEvents = False End With Set DestSh = ActiveWorkbook.Sheets(1) StartRow = 1 For Each sh In ActiveWorkbook.Worksheets If sh.Name < DestSh.Name Then Last = LastRow(DestSh) shLast = LastRow(sh) 'If sh is not empty and if the last row = StartRow copy the CopyRng If shLast 0 And shLast = StartRow Then 'Set the range that you want to copy Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast)) 'Test if there enough rows in the DestSh to copy all the data If Last + CopyRng.Rows.Count DestSh.Rows.Count Then MsgBox "There are not enough rows in the Destsh" GoTo ExitTheSub End If 'This example copies values/formats, if you only want to copy the 'values or want to copy everything look below example 1 on this page CopyRng.Copy With DestSh.Cells(Last + 1, "A") .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False End With End If Application.DisplayAlerts = False sh.Delete Application.DisplayAlerts = True End If Next ExitTheSub: Application.Goto DestSh.Cells(1) 'AutoFit the column width in the DestSh sheet DestSh.Columns.AutoFit With Application .ScreenUpdating = True .EnableEvents = True End With End Sub ======================= Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", After:=sh.Range("A1"), Lookat:=xlPart, _ LookIn:=xlFormulas, SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, MatchCase:=False).Row On Error GoTo 0 End Function ======================= |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Combine Text Files into One Worksheet
See this page for other code
http://www.rondebruin.nl/csv.htm -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "VBA_Newbie79" wrote in message ... This group is better than any "formal" training a gal could have. I've learned a lot over the years from you and I have another questions that I know you can help with. I need to combine multiple text files into one worksheet. This should be fairly straight forward, however I just can't get my arms around it. The text files (6 to 8 of them) need to have fixed length columns, with all columns formatted as text to retain leading zeros. The number of rows will most likely end up around 7000 for each text file. The code I have works fine, with a large portion of the various subs coming from this group. However, I don't think it needs to be as complex as it is. A Sub called FormatFiles starts everything off. Sub ImportTextFile brings in the text files and starts off other subs designed to combine the text files into one worksheet. I'm just going to include the subs that actually import the text files and combine them, to prevent this posting from being too long. Can you help me trim this down while still having it function as needed? ======================= Sub ImportTextFile() Dim File As Variant Dim i As Long Dim Book As Workbook File = Application.GetOpenFilename(FileFilter:="Text files (*.txt),*.txt", _ Title:="Select the files to import", MultiSelect:=True) If TypeName(File) = "Boolean" Then Exit Sub Application.ScreenUpdating = False Set Book = Workbooks.Add(xlWorksheet) For i = LBound(File) To UBound(File) ProcessFile WhichFile:=CStr(File(i)), WhichBook:=Book Next i Application.DisplayAlerts = False Book.Sheets(1).Delete Application.DisplayAlerts = True Application.ScreenUpdating = True Call CopyDataWithoutHeaders End Sub ======================= Sub ProcessFile(ByVal WhichFile As String, ByRef WhichBook As Workbook) Dim WS As Worksheet Dim ColumnInformation As Variant ColumnInformation = Array(Array(0, 2), Array(4, 2), Array(10, 2), Array(18, 2), _ Array(22, 2), Array(28, 2), Array(31, 2), Array(36, 2), _ Array(42, 2), Array(51, 2), Array(54, 2)) Workbooks.OpenText Filename:=WhichFile, Origin:=xlWindows, StartRow:=1, _ DataType:=xlFixedWidth, FieldInfo:=ColumnInformation Cells.Select Selection.Columns.AutoFit Range("A1").Select With ActiveSheet .Copy After:=WhichBook.Sheets(WhichBook.Sheets.Count) .Parent.Close SaveChanges:=False End With End Sub ======================= Sub CopyDataWithoutHeaders() Dim sh As Worksheet Dim DestSh As Worksheet Dim Last As Long Dim shLast As Long Dim CopyRng As Range Dim StartRow As Long With Application .ScreenUpdating = False .EnableEvents = False End With Set DestSh = ActiveWorkbook.Sheets(1) StartRow = 1 For Each sh In ActiveWorkbook.Worksheets If sh.Name < DestSh.Name Then Last = LastRow(DestSh) shLast = LastRow(sh) 'If sh is not empty and if the last row = StartRow copy the CopyRng If shLast 0 And shLast = StartRow Then 'Set the range that you want to copy Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast)) 'Test if there enough rows in the DestSh to copy all the data If Last + CopyRng.Rows.Count DestSh.Rows.Count Then MsgBox "There are not enough rows in the Destsh" GoTo ExitTheSub End If 'This example copies values/formats, if you only want to copy the 'values or want to copy everything look below example 1 on this page CopyRng.Copy With DestSh.Cells(Last + 1, "A") .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False End With End If Application.DisplayAlerts = False sh.Delete Application.DisplayAlerts = True End If Next ExitTheSub: Application.Goto DestSh.Cells(1) 'AutoFit the column width in the DestSh sheet DestSh.Columns.AutoFit With Application .ScreenUpdating = True .EnableEvents = True End With End Sub ======================= Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", After:=sh.Range("A1"), Lookat:=xlPart, _ LookIn:=xlFormulas, SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, MatchCase:=False).Row On Error GoTo 0 End Function ======================= |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Importing many text files into one excel worksheet - how to? | Excel Programming | |||
Upload multiple text files into 1 excel worksheet + put the filename as the first column in the worksheet | Excel Worksheet Functions | |||
Multiple Text files into one worksheet-need help | Excel Discussion (Misc queries) | |||
importing several text files into different excel worksheet | Excel Programming | |||
open text files as a worksheet | Excel Programming |