Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Joel - Importing multiple text files to 1 spreadsheet, now importing from excel files
Hi All,
I found the following example of the processing of text files in the newsgroup (thread 29.09.2008). The program flow is wished as well as by me. Nevertheless, the reading should occur from Excel-sheets. I have already tried to find from examples of Ron de Bruin and the code of Joel a solution. But I have not managed this. Only the import of the source sheets in the sheet "Input" would have to be customised. From all files of a folder will be imported in each case from a certain sheet two Columns. The sheet names are Jahr2008, Jahr2007, Jahr2006....... The first part of the sheet name is always "Jahr", followed by the annual number. The sheet construction is in each case in column A (ID), in column D (Betrag). These both columns should be imported in a sheet called "Input", there in the columns A (ID) and column B (Betrag). From there the data will be transmitted into a sheet called "Summary". This occurs sheet-wise, i.e. reading of the first sheet in "Input", then carry to "Summary", afterwards reading of the second sheet in "Input", then carry to "Summary" etc. If the ID exists, the corresponding value is entered on the annual column. A not yet available ID is complemented below in column A. The sheet construction is displayed in the following. Column A shows ID, in the following columns B, C... the accompanying amounts are entered. A new column is put on for every year. The headers are marked as follows: A1 ID, B1 Jahr2008, C1 Jahr2007, D1 Jahr2006 etc... Jahr2008, 2007 are the sheet names from the original source files. Input-Sheet year 1 A B ID Jahr2008 key01 10 key04 20 key07 30 Input-Sheet year 2 A B ID Jahr2007 key01 15 key02 25 key04 50 key08 22 Summary-Sheet A B C ID Jahr2008 Jahr2007 key01 10 15 key04 20 50 key07 30 key02 25 key08 22 Sub DatenEinlesen() Folder = "C:\temp\test2\" With ThisWorkbook Set InputSht = Worksheets.Add( _ after:=.Sheets(.Sheets.Count)) InputSht.Name = "Input" Set SummarySht = Worksheets.Add( _ after:=.Sheets(.Sheets.Count)) SummarySht.Name = "Summary" SummarySht.Range("A1") = "ID" End With ColCount = 2 NewRow = 2 FName = Dir(Folder & "*.xls") Do While FName < "" ---------------------------------------------------- ----- This code part is to be replaced ---- 'Input data file With InputSht .Cells.ClearContents With .QueryTables.Add( _ Connection:="TEXT;" & Folder & FName, _ Destination:=.Range("A1")) .Name = FName .SaveData = True .AdjustColumnWidth = True .TextFileStartRow = 1 .TextFileParseType = xlFixedWidth .TextFileColumnDataTypes = Array(1, 1, 1) .TextFileFixedColumnWidths = Array(16, 10) .Refresh BackgroundQuery:=False End With ------------------------------------------------------------- 'Move Data to Summary sheet SummarySht.Cells(1, ColCount) = FName RowCount = 2 Do While .Range("A" & RowCount) < "" ID = .Range("A" & RowCount) Betrag = .Range("B" & RowCount) With SummarySht Set c = .Columns("A").Find(what:=ID, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then .Range("A" & NewRow) = ID .Cells(NewRow, ColCount) = Betrag NewRow = NewRow + 1 Else .Cells(c.Row, ColCount) = Betrag End If End With RowCount = RowCount + 1 Loop End With ColCount = ColCount + 1 FName = Dir() Loop End Sub I would be very grateful for every help. Volker |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Joel - Importing multiple text files to 1 spreadsheet, now importi
I didn't test the code. You will need to change FOLDER as required. I
eliminated the Input Sheet and move the data directly from each of the workbooks to the summary sheet. I assume each workbook had multiple worksheet with differnt the code will work even with one worksheet in each workbook. The code is using the TAB name of the sheets to determine the column names in the summary sheet. Sub DatenEinlesen() Folder = "C:\temp\test2\" With ThisWorkbook Set SummarySht = .Worksheets.Add( _ after:=.Sheets(.Sheets.Count)) SummarySht.Name = "Summary" SummarySht.Range("A1") = "ID" End With With SummarySht NewRow = 2 NewCol = 2 FName = Dir(Folder & "*.xls") Do While FName < "" Set OldBk = Workbooks.Open(Filename:=Folder & FName) For Each Sht In OldBk.Sheets If UCase(Left(Sht.Name, 4)) = "JAHR" Then 'Test if columnn already exists Set c = .Rows(1).Find(what:=Sht.Name, _ LookIn:=xlValues, lookat:=xlwhat) If c Is Nothing Then .Cells(1, NewCol) = Sht.Name ColCount = NewCol NewCol = NewCol + 1 Else ColCount = c.Column End If RowCount = 2 'Move Data to Summary sheet Do While Sht.Range("A" & RowCount) < "" ID = Sht.Range("A" & RowCount) Betrag = Sht.Range("B" & RowCount) Set c = .Columns("A").Find(what:=ID, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then .Range("A" & NewRow) = ID .Cells(NewRow, ColCount) = Betrag NewRow = NewRow + 1 Else .Cells(c.Row, ColCount) = Betrag End If RowCount = RowCount + 1 Loop End If Next Sht OldBk.Close savechanges:=False FName = Dir() Loop End With End Sub "Volker Hormuth" wrote: Hi All, I found the following example of the processing of text files in the newsgroup (thread 29.09.2008). The program flow is wished as well as by me. Nevertheless, the reading should occur from Excel-sheets. I have already tried to find from examples of Ron de Bruin and the code of Joel a solution. But I have not managed this. Only the import of the source sheets in the sheet "Input" would have to be customised. From all files of a folder will be imported in each case from a certain sheet two Columns. The sheet names are Jahr2008, Jahr2007, Jahr2006....... The first part of the sheet name is always "Jahr", followed by the annual number. The sheet construction is in each case in column A (ID), in column D (Betrag). These both columns should be imported in a sheet called "Input", there in the columns A (ID) and column B (Betrag). From there the data will be transmitted into a sheet called "Summary". This occurs sheet-wise, i.e. reading of the first sheet in "Input", then carry to "Summary", afterwards reading of the second sheet in "Input", then carry to "Summary" etc. If the ID exists, the corresponding value is entered on the annual column. A not yet available ID is complemented below in column A. The sheet construction is displayed in the following. Column A shows ID, in the following columns B, C... the accompanying amounts are entered. A new column is put on for every year. The headers are marked as follows: A1 ID, B1 Jahr2008, C1 Jahr2007, D1 Jahr2006 etc... Jahr2008, 2007 are the sheet names from the original source files. Input-Sheet year 1 A B ID Jahr2008 key01 10 key04 20 key07 30 Input-Sheet year 2 A B ID Jahr2007 key01 15 key02 25 key04 50 key08 22 Summary-Sheet A B C ID Jahr2008 Jahr2007 key01 10 15 key04 20 50 key07 30 key02 25 key08 22 Sub DatenEinlesen() Folder = "C:\temp\test2\" With ThisWorkbook Set InputSht = Worksheets.Add( _ after:=.Sheets(.Sheets.Count)) InputSht.Name = "Input" Set SummarySht = Worksheets.Add( _ after:=.Sheets(.Sheets.Count)) SummarySht.Name = "Summary" SummarySht.Range("A1") = "ID" End With ColCount = 2 NewRow = 2 FName = Dir(Folder & "*.xls") Do While FName < "" ---------------------------------------------------- ----- This code part is to be replaced ---- 'Input data file With InputSht .Cells.ClearContents With .QueryTables.Add( _ Connection:="TEXT;" & Folder & FName, _ Destination:=.Range("A1")) .Name = FName .SaveData = True .AdjustColumnWidth = True .TextFileStartRow = 1 .TextFileParseType = xlFixedWidth .TextFileColumnDataTypes = Array(1, 1, 1) .TextFileFixedColumnWidths = Array(16, 10) .Refresh BackgroundQuery:=False End With ------------------------------------------------------------- 'Move Data to Summary sheet SummarySht.Cells(1, ColCount) = FName RowCount = 2 Do While .Range("A" & RowCount) < "" ID = .Range("A" & RowCount) Betrag = .Range("B" & RowCount) With SummarySht Set c = .Columns("A").Find(what:=ID, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then .Range("A" & NewRow) = ID .Cells(NewRow, ColCount) = Betrag NewRow = NewRow + 1 Else .Cells(c.Row, ColCount) = Betrag End If End With RowCount = RowCount + 1 Loop End With ColCount = ColCount + 1 FName = Dir() Loop End Sub I would be very grateful for every help. Volker |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Joel - Importing multiple text files to 1 spreadsheet, now importi
Hallo Joel,
many thanks for the quick response. At this point I receive an error message ( Nr 9 Laufzeitfehler - Index ausserhalb des Bereichs) 'Test if columnn already exists Set c = .Rows(1).Find(what:=Sht.Name, _ LookIn:=xlValues, lookat:=xlwhat) How must I change the code? Volker "joel" schrieb im Newsbeitrag ... I didn't test the code. You will need to change FOLDER as required. I eliminated the Input Sheet and move the data directly from each of the workbooks to the summary sheet. I assume each workbook had multiple worksheet with differnt the code will work even with one worksheet in each workbook. The code is using the TAB name of the sheets to determine the column names in the summary sheet. Sub DatenEinlesen() Folder = "C:\temp\test2\" With ThisWorkbook Set SummarySht = .Worksheets.Add( _ after:=.Sheets(.Sheets.Count)) SummarySht.Name = "Summary" SummarySht.Range("A1") = "ID" End With With SummarySht NewRow = 2 NewCol = 2 FName = Dir(Folder & "*.xls") Do While FName < "" Set OldBk = Workbooks.Open(Filename:=Folder & FName) For Each Sht In OldBk.Sheets If UCase(Left(Sht.Name, 4)) = "JAHR" Then 'Test if columnn already exists Set c = .Rows(1).Find(what:=Sht.Name, _ LookIn:=xlValues, lookat:=xlwhat) If c Is Nothing Then .Cells(1, NewCol) = Sht.Name ColCount = NewCol NewCol = NewCol + 1 Else ColCount = c.Column End If RowCount = 2 'Move Data to Summary sheet Do While Sht.Range("A" & RowCount) < "" ID = Sht.Range("A" & RowCount) Betrag = Sht.Range("B" & RowCount) Set c = .Columns("A").Find(what:=ID, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then .Range("A" & NewRow) = ID .Cells(NewRow, ColCount) = Betrag NewRow = NewRow + 1 Else .Cells(c.Row, ColCount) = Betrag End If RowCount = RowCount + 1 Loop End If Next Sht OldBk.Close savechanges:=False FName = Dir() Loop End With End Sub "Volker Hormuth" wrote: Hi All, I found the following example of the processing of text files in the newsgroup (thread 29.09.2008). The program flow is wished as well as by me. Nevertheless, the reading should occur from Excel-sheets. I have already tried to find from examples of Ron de Bruin and the code of Joel a solution. But I have not managed this. Only the import of the source sheets in the sheet "Input" would have to be customised. From all files of a folder will be imported in each case from a certain sheet two Columns. The sheet names are Jahr2008, Jahr2007, Jahr2006....... The first part of the sheet name is always "Jahr", followed by the annual number. The sheet construction is in each case in column A (ID), in column D (Betrag). These both columns should be imported in a sheet called "Input", there in the columns A (ID) and column B (Betrag). From there the data will be transmitted into a sheet called "Summary". This occurs sheet-wise, i.e. reading of the first sheet in "Input", then carry to "Summary", afterwards reading of the second sheet in "Input", then carry to "Summary" etc. If the ID exists, the corresponding value is entered on the annual column. A not yet available ID is complemented below in column A. The sheet construction is displayed in the following. Column A shows ID, in the following columns B, C... the accompanying amounts are entered. A new column is put on for every year. The headers are marked as follows: A1 ID, B1 Jahr2008, C1 Jahr2007, D1 Jahr2006 etc... Jahr2008, 2007 are the sheet names from the original source files. Input-Sheet year 1 A B ID Jahr2008 key01 10 key04 20 key07 30 Input-Sheet year 2 A B ID Jahr2007 key01 15 key02 25 key04 50 key08 22 Summary-Sheet A B C ID Jahr2008 Jahr2007 key01 10 15 key04 20 50 key07 30 key02 25 key08 22 Sub DatenEinlesen() Folder = "C:\temp\test2\" With ThisWorkbook Set InputSht = Worksheets.Add( _ after:=.Sheets(.Sheets.Count)) InputSht.Name = "Input" Set SummarySht = Worksheets.Add( _ after:=.Sheets(.Sheets.Count)) SummarySht.Name = "Summary" SummarySht.Range("A1") = "ID" End With ColCount = 2 NewRow = 2 FName = Dir(Folder & "*.xls") Do While FName < "" ---------------------------------------------------- ----- This code part is to be replaced ---- 'Input data file With InputSht .Cells.ClearContents With .QueryTables.Add( _ Connection:="TEXT;" & Folder & FName, _ Destination:=.Range("A1")) .Name = FName .SaveData = True .AdjustColumnWidth = True .TextFileStartRow = 1 .TextFileParseType = xlFixedWidth .TextFileColumnDataTypes = Array(1, 1, 1) .TextFileFixedColumnWidths = Array(16, 10) .Refresh BackgroundQuery:=False End With ------------------------------------------------------------- 'Move Data to Summary sheet SummarySht.Cells(1, ColCount) = FName RowCount = 2 Do While .Range("A" & RowCount) < "" ID = .Range("A" & RowCount) Betrag = .Range("B" & RowCount) With SummarySht Set c = .Columns("A").Find(what:=ID, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then .Range("A" & NewRow) = ID .Cells(NewRow, ColCount) = Betrag NewRow = NewRow + 1 Else .Cells(c.Row, ColCount) = Betrag End If End With RowCount = RowCount + 1 Loop End With ColCount = ColCount + 1 FName = Dir() Loop End Sub I would be very grateful for every help. Volker |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Joel - Importing multiple text files to 1 spreadsheet, now imp
I misspelled the word xlWhole
'Test if columnn already exists Set c = .Rows(1).Find(what:=sht.Name, _ LookIn:=xlValues, lookat:=xlWhole) "Volker Hormuth" wrote: Hallo Joel, many thanks for the quick response. At this point I receive an error message ( Nr 9 Laufzeitfehler - Index ausserhalb des Bereichs) 'Test if columnn already exists Set c = .Rows(1).Find(what:=Sht.Name, _ LookIn:=xlValues, lookat:=xlwhat) How must I change the code? Volker "joel" schrieb im Newsbeitrag ... I didn't test the code. You will need to change FOLDER as required. I eliminated the Input Sheet and move the data directly from each of the workbooks to the summary sheet. I assume each workbook had multiple worksheet with differnt the code will work even with one worksheet in each workbook. The code is using the TAB name of the sheets to determine the column names in the summary sheet. Sub DatenEinlesen() Folder = "C:\temp\test2\" With ThisWorkbook Set SummarySht = .Worksheets.Add( _ after:=.Sheets(.Sheets.Count)) SummarySht.Name = "Summary" SummarySht.Range("A1") = "ID" End With With SummarySht NewRow = 2 NewCol = 2 FName = Dir(Folder & "*.xls") Do While FName < "" Set OldBk = Workbooks.Open(Filename:=Folder & FName) For Each Sht In OldBk.Sheets If UCase(Left(Sht.Name, 4)) = "JAHR" Then 'Test if columnn already exists Set c = .Rows(1).Find(what:=Sht.Name, _ LookIn:=xlValues, lookat:=xlwhat) If c Is Nothing Then .Cells(1, NewCol) = Sht.Name ColCount = NewCol NewCol = NewCol + 1 Else ColCount = c.Column End If RowCount = 2 'Move Data to Summary sheet Do While Sht.Range("A" & RowCount) < "" ID = Sht.Range("A" & RowCount) Betrag = Sht.Range("B" & RowCount) Set c = .Columns("A").Find(what:=ID, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then .Range("A" & NewRow) = ID .Cells(NewRow, ColCount) = Betrag NewRow = NewRow + 1 Else .Cells(c.Row, ColCount) = Betrag End If RowCount = RowCount + 1 Loop End If Next Sht OldBk.Close savechanges:=False FName = Dir() Loop End With End Sub "Volker Hormuth" wrote: Hi All, I found the following example of the processing of text files in the newsgroup (thread 29.09.2008). The program flow is wished as well as by me. Nevertheless, the reading should occur from Excel-sheets. I have already tried to find from examples of Ron de Bruin and the code of Joel a solution. But I have not managed this. Only the import of the source sheets in the sheet "Input" would have to be customised. From all files of a folder will be imported in each case from a certain sheet two Columns. The sheet names are Jahr2008, Jahr2007, Jahr2006....... The first part of the sheet name is always "Jahr", followed by the annual number. The sheet construction is in each case in column A (ID), in column D (Betrag). These both columns should be imported in a sheet called "Input", there in the columns A (ID) and column B (Betrag). From there the data will be transmitted into a sheet called "Summary". This occurs sheet-wise, i.e. reading of the first sheet in "Input", then carry to "Summary", afterwards reading of the second sheet in "Input", then carry to "Summary" etc. If the ID exists, the corresponding value is entered on the annual column. A not yet available ID is complemented below in column A. The sheet construction is displayed in the following. Column A shows ID, in the following columns B, C... the accompanying amounts are entered. A new column is put on for every year. The headers are marked as follows: A1 ID, B1 Jahr2008, C1 Jahr2007, D1 Jahr2006 etc... Jahr2008, 2007 are the sheet names from the original source files. Input-Sheet year 1 A B ID Jahr2008 key01 10 key04 20 key07 30 Input-Sheet year 2 A B ID Jahr2007 key01 15 key02 25 key04 50 key08 22 Summary-Sheet A B C ID Jahr2008 Jahr2007 key01 10 15 key04 20 50 key07 30 key02 25 key08 22 Sub DatenEinlesen() Folder = "C:\temp\test2\" With ThisWorkbook Set InputSht = Worksheets.Add( _ after:=.Sheets(.Sheets.Count)) InputSht.Name = "Input" Set SummarySht = Worksheets.Add( _ after:=.Sheets(.Sheets.Count)) SummarySht.Name = "Summary" SummarySht.Range("A1") = "ID" End With ColCount = 2 NewRow = 2 FName = Dir(Folder & "*.xls") Do While FName < "" ---------------------------------------------------- ----- This code part is to be replaced ---- 'Input data file With InputSht .Cells.ClearContents With .QueryTables.Add( _ Connection:="TEXT;" & Folder & FName, _ Destination:=.Range("A1")) .Name = FName .SaveData = True .AdjustColumnWidth = True .TextFileStartRow = 1 .TextFileParseType = xlFixedWidth .TextFileColumnDataTypes = Array(1, 1, 1) .TextFileFixedColumnWidths = Array(16, 10) .Refresh BackgroundQuery:=False End With ------------------------------------------------------------- 'Move Data to Summary sheet SummarySht.Cells(1, ColCount) = FName RowCount = 2 Do While .Range("A" & RowCount) < "" ID = .Range("A" & RowCount) Betrag = .Range("B" & RowCount) With SummarySht Set c = .Columns("A").Find(what:=ID, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then .Range("A" & NewRow) = ID .Cells(NewRow, ColCount) = Betrag NewRow = NewRow + 1 Else .Cells(c.Row, ColCount) = Betrag End If End With RowCount = RowCount + 1 Loop End With ColCount = ColCount + 1 FName = Dir() Loop End Sub I would be very grateful for every help. Volker |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Joel - Importing multiple text files to 1 spreadsheet, now imp
Hi Joel,
the code runs as well as I have wished it. I will save with it in future a lot of time. Again many thanks for your help. I still wish you nice Sunday. Volker "joel" schrieb im Newsbeitrag ... I misspelled the word xlWhole 'Test if columnn already exists Set c = .Rows(1).Find(what:=sht.Name, _ LookIn:=xlValues, lookat:=xlWhole) "Volker Hormuth" wrote: Hallo Joel, many thanks for the quick response. At this point I receive an error message ( Nr 9 Laufzeitfehler - Index ausserhalb des Bereichs) 'Test if columnn already exists Set c = .Rows(1).Find(what:=Sht.Name, _ LookIn:=xlValues, lookat:=xlwhat) How must I change the code? Volker "joel" schrieb im Newsbeitrag ... I didn't test the code. You will need to change FOLDER as required. I eliminated the Input Sheet and move the data directly from each of the workbooks to the summary sheet. I assume each workbook had multiple worksheet with differnt the code will work even with one worksheet in each workbook. The code is using the TAB name of the sheets to determine the column names in the summary sheet. Sub DatenEinlesen() Folder = "C:\temp\test2\" With ThisWorkbook Set SummarySht = .Worksheets.Add( _ after:=.Sheets(.Sheets.Count)) SummarySht.Name = "Summary" SummarySht.Range("A1") = "ID" End With With SummarySht NewRow = 2 NewCol = 2 FName = Dir(Folder & "*.xls") Do While FName < "" Set OldBk = Workbooks.Open(Filename:=Folder & FName) For Each Sht In OldBk.Sheets If UCase(Left(Sht.Name, 4)) = "JAHR" Then 'Test if columnn already exists Set c = .Rows(1).Find(what:=Sht.Name, _ LookIn:=xlValues, lookat:=xlwhat) If c Is Nothing Then .Cells(1, NewCol) = Sht.Name ColCount = NewCol NewCol = NewCol + 1 Else ColCount = c.Column End If RowCount = 2 'Move Data to Summary sheet Do While Sht.Range("A" & RowCount) < "" ID = Sht.Range("A" & RowCount) Betrag = Sht.Range("B" & RowCount) Set c = .Columns("A").Find(what:=ID, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then .Range("A" & NewRow) = ID .Cells(NewRow, ColCount) = Betrag NewRow = NewRow + 1 Else .Cells(c.Row, ColCount) = Betrag End If RowCount = RowCount + 1 Loop End If Next Sht OldBk.Close savechanges:=False FName = Dir() Loop End With End Sub "Volker Hormuth" wrote: Hi All, I found the following example of the processing of text files in the newsgroup (thread 29.09.2008). The program flow is wished as well as by me. Nevertheless, the reading should occur from Excel-sheets. I have already tried to find from examples of Ron de Bruin and the code of Joel a solution. But I have not managed this. Only the import of the source sheets in the sheet "Input" would have to be customised. From all files of a folder will be imported in each case from a certain sheet two Columns. The sheet names are Jahr2008, Jahr2007, Jahr2006....... The first part of the sheet name is always "Jahr", followed by the annual number. The sheet construction is in each case in column A (ID), in column D (Betrag). These both columns should be imported in a sheet called "Input", there in the columns A (ID) and column B (Betrag). From there the data will be transmitted into a sheet called "Summary". This occurs sheet-wise, i.e. reading of the first sheet in "Input", then carry to "Summary", afterwards reading of the second sheet in "Input", then carry to "Summary" etc. If the ID exists, the corresponding value is entered on the annual column. A not yet available ID is complemented below in column A. The sheet construction is displayed in the following. Column A shows ID, in the following columns B, C... the accompanying amounts are entered. A new column is put on for every year. The headers are marked as follows: A1 ID, B1 Jahr2008, C1 Jahr2007, D1 Jahr2006 etc... Jahr2008, 2007 are the sheet names from the original source files. Input-Sheet year 1 A B ID Jahr2008 key01 10 key04 20 key07 30 Input-Sheet year 2 A B ID Jahr2007 key01 15 key02 25 key04 50 key08 22 Summary-Sheet A B C ID Jahr2008 Jahr2007 key01 10 15 key04 20 50 key07 30 key02 25 key08 22 Sub DatenEinlesen() Folder = "C:\temp\test2\" With ThisWorkbook Set InputSht = Worksheets.Add( _ after:=.Sheets(.Sheets.Count)) InputSht.Name = "Input" Set SummarySht = Worksheets.Add( _ after:=.Sheets(.Sheets.Count)) SummarySht.Name = "Summary" SummarySht.Range("A1") = "ID" End With ColCount = 2 NewRow = 2 FName = Dir(Folder & "*.xls") Do While FName < "" ---------------------------------------------------- ----- This code part is to be replaced ---- 'Input data file With InputSht .Cells.ClearContents With .QueryTables.Add( _ Connection:="TEXT;" & Folder & FName, _ Destination:=.Range("A1")) .Name = FName .SaveData = True .AdjustColumnWidth = True .TextFileStartRow = 1 .TextFileParseType = xlFixedWidth .TextFileColumnDataTypes = Array(1, 1, 1) .TextFileFixedColumnWidths = Array(16, 10) .Refresh BackgroundQuery:=False End With ------------------------------------------------------------- 'Move Data to Summary sheet SummarySht.Cells(1, ColCount) = FName RowCount = 2 Do While .Range("A" & RowCount) < "" ID = .Range("A" & RowCount) Betrag = .Range("B" & RowCount) With SummarySht Set c = .Columns("A").Find(what:=ID, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then .Range("A" & NewRow) = ID .Cells(NewRow, ColCount) = Betrag NewRow = NewRow + 1 Else .Cells(c.Row, ColCount) = Betrag End If End With RowCount = RowCount + 1 Loop End With ColCount = ColCount + 1 FName = Dir() Loop End Sub I would be very grateful for every help. Volker |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Joel - Importing multiple text files to 1 spreadsheet, now imp
This is how I import multiple text files into one Sheet:
Sub Import_Multiple_Text_Files() Dim F As Variant Dim x As Integer Const MyPath = "c:\temp\" first = True RowCount = 1 Do If first = True Then Filename = Dir(MyPath & "*.txt") first = False Else Filename = Dir() End If If Filename < "" Then Open (MyPath & Filename) For Input Access Read As #1 Do Until EOF(1) Line Input #1, qdata If qdata < "" Then Cells(RowCount, 1) = qdata RowCount = RowCount + 1 End If Loop Close #1 End If Loop While Filename < "" End Sub Similar to above, but with a slight twist: Sub Import_Multiple_Text_Files() Dim FileS As FileSearch Dim F As Variant Dim x As Integer 'switch calculation off to speed up macro Application.Calculation = xlManual 'Pick up file path information qfolder = [B5] Set FileS = Application.FileSearch With FileS .NewSearch .Filename = "*" .LookIn = qfolder .SearchSubFolders = True .Execute End With x = 1 Sheets("Data").Select For Each F In Application.FileSearch.FoundFiles Open F For Input Access Read As #1 Do Until EOF(1) Line Input #1, qdata If qdata < "" Then Cells(x, 1) = qdata x = x + 1 End If Loop Close #1 Next F End Sub Cell B5 has this: C:\Test HTH, Ryan--- -- Ryan--- If this information was helpful, please indicate this by clicking ''Yes''. "Volker Hormuth" wrote: Hi Joel, the code runs as well as I have wished it. I will save with it in future a lot of time. Again many thanks for your help. I still wish you nice Sunday. Volker "joel" schrieb im Newsbeitrag ... I misspelled the word xlWhole 'Test if columnn already exists Set c = .Rows(1).Find(what:=sht.Name, _ LookIn:=xlValues, lookat:=xlWhole) "Volker Hormuth" wrote: Hallo Joel, many thanks for the quick response. At this point I receive an error message ( Nr 9 Laufzeitfehler - Index ausserhalb des Bereichs) 'Test if columnn already exists Set c = .Rows(1).Find(what:=Sht.Name, _ LookIn:=xlValues, lookat:=xlwhat) How must I change the code? Volker "joel" schrieb im Newsbeitrag ... I didn't test the code. You will need to change FOLDER as required. I eliminated the Input Sheet and move the data directly from each of the workbooks to the summary sheet. I assume each workbook had multiple worksheet with differnt the code will work even with one worksheet in each workbook. The code is using the TAB name of the sheets to determine the column names in the summary sheet. Sub DatenEinlesen() Folder = "C:\temp\test2\" With ThisWorkbook Set SummarySht = .Worksheets.Add( _ after:=.Sheets(.Sheets.Count)) SummarySht.Name = "Summary" SummarySht.Range("A1") = "ID" End With With SummarySht NewRow = 2 NewCol = 2 FName = Dir(Folder & "*.xls") Do While FName < "" Set OldBk = Workbooks.Open(Filename:=Folder & FName) For Each Sht In OldBk.Sheets If UCase(Left(Sht.Name, 4)) = "JAHR" Then 'Test if columnn already exists Set c = .Rows(1).Find(what:=Sht.Name, _ LookIn:=xlValues, lookat:=xlwhat) If c Is Nothing Then .Cells(1, NewCol) = Sht.Name ColCount = NewCol NewCol = NewCol + 1 Else ColCount = c.Column End If RowCount = 2 'Move Data to Summary sheet Do While Sht.Range("A" & RowCount) < "" ID = Sht.Range("A" & RowCount) Betrag = Sht.Range("B" & RowCount) Set c = .Columns("A").Find(what:=ID, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then .Range("A" & NewRow) = ID .Cells(NewRow, ColCount) = Betrag NewRow = NewRow + 1 Else .Cells(c.Row, ColCount) = Betrag End If RowCount = RowCount + 1 Loop End If Next Sht OldBk.Close savechanges:=False FName = Dir() Loop End With End Sub "Volker Hormuth" wrote: Hi All, I found the following example of the processing of text files in the newsgroup (thread 29.09.2008). The program flow is wished as well as by me. Nevertheless, the reading should occur from Excel-sheets. I have already tried to find from examples of Ron de Bruin and the code of Joel a solution. But I have not managed this. Only the import of the source sheets in the sheet "Input" would have to be customised. From all files of a folder will be imported in each case from a certain sheet two Columns. The sheet names are Jahr2008, Jahr2007, Jahr2006....... The first part of the sheet name is always "Jahr", followed by the annual number. The sheet construction is in each case in column A (ID), in column D (Betrag). These both columns should be imported in a sheet called "Input", there in the columns A (ID) and column B (Betrag). From there the data will be transmitted into a sheet called "Summary". This occurs sheet-wise, i.e. reading of the first sheet in "Input", then carry to "Summary", afterwards reading of the second sheet in "Input", then carry to "Summary" etc. If the ID exists, the corresponding value is entered on the annual column. A not yet available ID is complemented below in column A. The sheet construction is displayed in the following. Column A shows ID, in the following columns B, C... the accompanying amounts are entered. A new column is put on for every year. The headers are marked as follows: A1 ID, B1 Jahr2008, C1 Jahr2007, D1 Jahr2006 etc... Jahr2008, 2007 are the sheet names from the original source files. Input-Sheet year 1 A B ID Jahr2008 key01 10 key04 20 key07 30 Input-Sheet year 2 A B ID Jahr2007 key01 15 key02 25 key04 50 key08 22 Summary-Sheet A B C ID Jahr2008 Jahr2007 key01 10 15 key04 20 50 key07 30 key02 25 key08 22 Sub DatenEinlesen() Folder = "C:\temp\test2\" With ThisWorkbook Set InputSht = Worksheets.Add( _ after:=.Sheets(.Sheets.Count)) InputSht.Name = "Input" Set SummarySht = Worksheets.Add( _ after:=.Sheets(.Sheets.Count)) SummarySht.Name = "Summary" SummarySht.Range("A1") = "ID" End With ColCount = 2 NewRow = 2 FName = Dir(Folder & "*.xls") Do While FName < "" ---------------------------------------------------- ----- This code part is to be replaced ---- 'Input data file With InputSht .Cells.ClearContents With .QueryTables.Add( _ Connection:="TEXT;" & Folder & FName, _ Destination:=.Range("A1")) .Name = FName .SaveData = True .AdjustColumnWidth = True .TextFileStartRow = 1 .TextFileParseType = xlFixedWidth .TextFileColumnDataTypes = Array(1, 1, 1) .TextFileFixedColumnWidths = Array(16, 10) .Refresh BackgroundQuery:=False End With ------------------------------------------------------------- 'Move Data to Summary sheet SummarySht.Cells(1, ColCount) = FName RowCount = 2 Do While .Range("A" & RowCount) < "" ID = .Range("A" & RowCount) Betrag = .Range("B" & RowCount) With SummarySht Set c = .Columns("A").Find(what:=ID, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then .Range("A" & NewRow) = ID .Cells(NewRow, ColCount) = Betrag NewRow = NewRow + 1 Else .Cells(c.Row, ColCount) = Betrag End If End With RowCount = RowCount + 1 Loop End With ColCount = ColCount + 1 FName = Dir() Loop End Sub I would be very grateful for every help. Volker |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Joel - Importing multiple text files to 1 spreadsheet, now imp
See also
http://www.rondebruin.nl/csv.htm -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "ryguy7272" wrote in message ... This is how I import multiple text files into one Sheet: Sub Import_Multiple_Text_Files() Dim F As Variant Dim x As Integer Const MyPath = "c:\temp\" first = True RowCount = 1 Do If first = True Then Filename = Dir(MyPath & "*.txt") first = False Else Filename = Dir() End If If Filename < "" Then Open (MyPath & Filename) For Input Access Read As #1 Do Until EOF(1) Line Input #1, qdata If qdata < "" Then Cells(RowCount, 1) = qdata RowCount = RowCount + 1 End If Loop Close #1 End If Loop While Filename < "" End Sub Similar to above, but with a slight twist: Sub Import_Multiple_Text_Files() Dim FileS As FileSearch Dim F As Variant Dim x As Integer 'switch calculation off to speed up macro Application.Calculation = xlManual 'Pick up file path information qfolder = [B5] Set FileS = Application.FileSearch With FileS .NewSearch .Filename = "*" .LookIn = qfolder .SearchSubFolders = True .Execute End With x = 1 Sheets("Data").Select For Each F In Application.FileSearch.FoundFiles Open F For Input Access Read As #1 Do Until EOF(1) Line Input #1, qdata If qdata < "" Then Cells(x, 1) = qdata x = x + 1 End If Loop Close #1 Next F End Sub Cell B5 has this: C:\Test HTH, Ryan--- -- Ryan--- If this information was helpful, please indicate this by clicking ''Yes''. "Volker Hormuth" wrote: Hi Joel, the code runs as well as I have wished it. I will save with it in future a lot of time. Again many thanks for your help. I still wish you nice Sunday. Volker "joel" schrieb im Newsbeitrag ... I misspelled the word xlWhole 'Test if columnn already exists Set c = .Rows(1).Find(what:=sht.Name, _ LookIn:=xlValues, lookat:=xlWhole) "Volker Hormuth" wrote: Hallo Joel, many thanks for the quick response. At this point I receive an error message ( Nr 9 Laufzeitfehler - Index ausserhalb des Bereichs) 'Test if columnn already exists Set c = .Rows(1).Find(what:=Sht.Name, _ LookIn:=xlValues, lookat:=xlwhat) How must I change the code? Volker "joel" schrieb im Newsbeitrag ... I didn't test the code. You will need to change FOLDER as required. I eliminated the Input Sheet and move the data directly from each of the workbooks to the summary sheet. I assume each workbook had multiple worksheet with differnt the code will work even with one worksheet in each workbook. The code is using the TAB name of the sheets to determine the column names in the summary sheet. Sub DatenEinlesen() Folder = "C:\temp\test2\" With ThisWorkbook Set SummarySht = .Worksheets.Add( _ after:=.Sheets(.Sheets.Count)) SummarySht.Name = "Summary" SummarySht.Range("A1") = "ID" End With With SummarySht NewRow = 2 NewCol = 2 FName = Dir(Folder & "*.xls") Do While FName < "" Set OldBk = Workbooks.Open(Filename:=Folder & FName) For Each Sht In OldBk.Sheets If UCase(Left(Sht.Name, 4)) = "JAHR" Then 'Test if columnn already exists Set c = .Rows(1).Find(what:=Sht.Name, _ LookIn:=xlValues, lookat:=xlwhat) If c Is Nothing Then .Cells(1, NewCol) = Sht.Name ColCount = NewCol NewCol = NewCol + 1 Else ColCount = c.Column End If RowCount = 2 'Move Data to Summary sheet Do While Sht.Range("A" & RowCount) < "" ID = Sht.Range("A" & RowCount) Betrag = Sht.Range("B" & RowCount) Set c = .Columns("A").Find(what:=ID, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then .Range("A" & NewRow) = ID .Cells(NewRow, ColCount) = Betrag NewRow = NewRow + 1 Else .Cells(c.Row, ColCount) = Betrag End If RowCount = RowCount + 1 Loop End If Next Sht OldBk.Close savechanges:=False FName = Dir() Loop End With End Sub "Volker Hormuth" wrote: Hi All, I found the following example of the processing of text files in the newsgroup (thread 29.09.2008). The program flow is wished as well as by me. Nevertheless, the reading should occur from Excel-sheets. I have already tried to find from examples of Ron de Bruin and the code of Joel a solution. But I have not managed this. Only the import of the source sheets in the sheet "Input" would have to be customised. From all files of a folder will be imported in each case from a certain sheet two Columns. The sheet names are Jahr2008, Jahr2007, Jahr2006....... The first part of the sheet name is always "Jahr", followed by the annual number. The sheet construction is in each case in column A (ID), in column D (Betrag). These both columns should be imported in a sheet called "Input", there in the columns A (ID) and column B (Betrag). From there the data will be transmitted into a sheet called "Summary". This occurs sheet-wise, i.e. reading of the first sheet in "Input", then carry to "Summary", afterwards reading of the second sheet in "Input", then carry to "Summary" etc. If the ID exists, the corresponding value is entered on the annual column. A not yet available ID is complemented below in column A. The sheet construction is displayed in the following. Column A shows ID, in the following columns B, C... the accompanying amounts are entered. A new column is put on for every year. The headers are marked as follows: A1 ID, B1 Jahr2008, C1 Jahr2007, D1 Jahr2006 etc... Jahr2008, 2007 are the sheet names from the original source files. Input-Sheet year 1 A B ID Jahr2008 key01 10 key04 20 key07 30 Input-Sheet year 2 A B ID Jahr2007 key01 15 key02 25 key04 50 key08 22 Summary-Sheet A B C ID Jahr2008 Jahr2007 key01 10 15 key04 20 50 key07 30 key02 25 key08 22 Sub DatenEinlesen() Folder = "C:\temp\test2\" With ThisWorkbook Set InputSht = Worksheets.Add( _ after:=.Sheets(.Sheets.Count)) InputSht.Name = "Input" Set SummarySht = Worksheets.Add( _ after:=.Sheets(.Sheets.Count)) SummarySht.Name = "Summary" SummarySht.Range("A1") = "ID" End With ColCount = 2 NewRow = 2 FName = Dir(Folder & "*.xls") Do While FName < "" ---------------------------------------------------- ----- This code part is to be replaced ---- 'Input data file With InputSht .Cells.ClearContents With .QueryTables.Add( _ Connection:="TEXT;" & Folder & FName, _ Destination:=.Range("A1")) .Name = FName .SaveData = True .AdjustColumnWidth = True .TextFileStartRow = 1 .TextFileParseType = xlFixedWidth .TextFileColumnDataTypes = Array(1, 1, 1) .TextFileFixedColumnWidths = Array(16, 10) .Refresh BackgroundQuery:=False End With ------------------------------------------------------------- 'Move Data to Summary sheet SummarySht.Cells(1, ColCount) = FName RowCount = 2 Do While .Range("A" & RowCount) < "" ID = .Range("A" & RowCount) Betrag = .Range("B" & RowCount) With SummarySht Set c = .Columns("A").Find(what:=ID, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then .Range("A" & NewRow) = ID .Cells(NewRow, ColCount) = Betrag NewRow = NewRow + 1 Else .Cells(c.Row, ColCount) = Betrag End If End With RowCount = RowCount + 1 Loop End With ColCount = ColCount + 1 FName = Dir() Loop End Sub I would be very grateful for every help. Volker |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Joel - Importing multiple text files to 1 spreadsheet, now imp
Hi Ron and Ryguy 7272,
many thanks for the complementary information. Volker "Ron de Bruin" schrieb im Newsbeitrag ... See also http://www.rondebruin.nl/csv.htm -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "ryguy7272" wrote in message ... This is how I import multiple text files into one Sheet: Sub Import_Multiple_Text_Files() Dim F As Variant Dim x As Integer Const MyPath = "c:\temp\" first = True RowCount = 1 Do If first = True Then Filename = Dir(MyPath & "*.txt") first = False Else Filename = Dir() End If If Filename < "" Then Open (MyPath & Filename) For Input Access Read As #1 Do Until EOF(1) Line Input #1, qdata If qdata < "" Then Cells(RowCount, 1) = qdata RowCount = RowCount + 1 End If Loop Close #1 End If Loop While Filename < "" End Sub Similar to above, but with a slight twist: Sub Import_Multiple_Text_Files() Dim FileS As FileSearch Dim F As Variant Dim x As Integer 'switch calculation off to speed up macro Application.Calculation = xlManual 'Pick up file path information qfolder = [B5] Set FileS = Application.FileSearch With FileS .NewSearch .Filename = "*" .LookIn = qfolder .SearchSubFolders = True .Execute End With x = 1 Sheets("Data").Select For Each F In Application.FileSearch.FoundFiles Open F For Input Access Read As #1 Do Until EOF(1) Line Input #1, qdata If qdata < "" Then Cells(x, 1) = qdata x = x + 1 End If Loop Close #1 Next F End Sub Cell B5 has this: C:\Test HTH, Ryan--- -- Ryan--- If this information was helpful, please indicate this by clicking ''Yes''. "Volker Hormuth" wrote: Hi Joel, the code runs as well as I have wished it. I will save with it in future a lot of time. Again many thanks for your help. I still wish you nice Sunday. Volker "joel" schrieb im Newsbeitrag ... I misspelled the word xlWhole 'Test if columnn already exists Set c = .Rows(1).Find(what:=sht.Name, _ LookIn:=xlValues, lookat:=xlWhole) "Volker Hormuth" wrote: Hallo Joel, many thanks for the quick response. At this point I receive an error message ( Nr 9 Laufzeitfehler - Index ausserhalb des Bereichs) 'Test if columnn already exists Set c = .Rows(1).Find(what:=Sht.Name, _ LookIn:=xlValues, lookat:=xlwhat) How must I change the code? Volker "joel" schrieb im Newsbeitrag ... I didn't test the code. You will need to change FOLDER as required. I eliminated the Input Sheet and move the data directly from each of the workbooks to the summary sheet. I assume each workbook had multiple worksheet with differnt the code will work even with one worksheet in each workbook. The code is using the TAB name of the sheets to determine the column names in the summary sheet. Sub DatenEinlesen() Folder = "C:\temp\test2\" With ThisWorkbook Set SummarySht = .Worksheets.Add( _ after:=.Sheets(.Sheets.Count)) SummarySht.Name = "Summary" SummarySht.Range("A1") = "ID" End With With SummarySht NewRow = 2 NewCol = 2 FName = Dir(Folder & "*.xls") Do While FName < "" Set OldBk = Workbooks.Open(Filename:=Folder & FName) For Each Sht In OldBk.Sheets If UCase(Left(Sht.Name, 4)) = "JAHR" Then 'Test if columnn already exists Set c = .Rows(1).Find(what:=Sht.Name, _ LookIn:=xlValues, lookat:=xlwhat) If c Is Nothing Then .Cells(1, NewCol) = Sht.Name ColCount = NewCol NewCol = NewCol + 1 Else ColCount = c.Column End If RowCount = 2 'Move Data to Summary sheet Do While Sht.Range("A" & RowCount) < "" ID = Sht.Range("A" & RowCount) Betrag = Sht.Range("B" & RowCount) Set c = .Columns("A").Find(what:=ID, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then .Range("A" & NewRow) = ID .Cells(NewRow, ColCount) = Betrag NewRow = NewRow + 1 Else .Cells(c.Row, ColCount) = Betrag End If RowCount = RowCount + 1 Loop End If Next Sht OldBk.Close savechanges:=False FName = Dir() Loop End With End Sub "Volker Hormuth" wrote: Hi All, I found the following example of the processing of text files in the newsgroup (thread 29.09.2008). The program flow is wished as well as by me. Nevertheless, the reading should occur from Excel-sheets. I have already tried to find from examples of Ron de Bruin and the code of Joel a solution. But I have not managed this. Only the import of the source sheets in the sheet "Input" would have to be customised. From all files of a folder will be imported in each case from a certain sheet two Columns. The sheet names are Jahr2008, Jahr2007, Jahr2006....... The first part of the sheet name is always "Jahr", followed by the annual number. The sheet construction is in each case in column A (ID), in column D (Betrag). These both columns should be imported in a sheet called "Input", there in the columns A (ID) and column B (Betrag). From there the data will be transmitted into a sheet called "Summary". This occurs sheet-wise, i.e. reading of the first sheet in "Input", then carry to "Summary", afterwards reading of the second sheet in "Input", then carry to "Summary" etc. If the ID exists, the corresponding value is entered on the annual column. A not yet available ID is complemented below in column A. The sheet construction is displayed in the following. Column A shows ID, in the following columns B, C... the accompanying amounts are entered. A new column is put on for every year. The headers are marked as follows: A1 ID, B1 Jahr2008, C1 Jahr2007, D1 Jahr2006 etc... Jahr2008, 2007 are the sheet names from the original source files. Input-Sheet year 1 A B ID Jahr2008 key01 10 key04 20 key07 30 Input-Sheet year 2 A B ID Jahr2007 key01 15 key02 25 key04 50 key08 22 Summary-Sheet A B C ID Jahr2008 Jahr2007 key01 10 15 key04 20 50 key07 30 key02 25 key08 22 Sub DatenEinlesen() Folder = "C:\temp\test2\" With ThisWorkbook Set InputSht = Worksheets.Add( _ after:=.Sheets(.Sheets.Count)) InputSht.Name = "Input" Set SummarySht = Worksheets.Add( _ after:=.Sheets(.Sheets.Count)) SummarySht.Name = "Summary" SummarySht.Range("A1") = "ID" End With ColCount = 2 NewRow = 2 FName = Dir(Folder & "*.xls") Do While FName < "" ---------------------------------------------------- ----- This code part is to be replaced ---- 'Input data file With InputSht .Cells.ClearContents With .QueryTables.Add( _ Connection:="TEXT;" & Folder & FName, _ Destination:=.Range("A1")) .Name = FName .SaveData = True .AdjustColumnWidth = True .TextFileStartRow = 1 .TextFileParseType = xlFixedWidth .TextFileColumnDataTypes = Array(1, 1, 1) .TextFileFixedColumnWidths = Array(16, 10) .Refresh BackgroundQuery:=False End With ------------------------------------------------------------- 'Move Data to Summary sheet SummarySht.Cells(1, ColCount) = FName RowCount = 2 Do While .Range("A" & RowCount) < "" ID = .Range("A" & RowCount) Betrag = .Range("B" & RowCount) With SummarySht Set c = .Columns("A").Find(what:=ID, _ LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then .Range("A" & NewRow) = ID .Cells(NewRow, ColCount) = Betrag NewRow = NewRow + 1 Else .Cells(c.Row, ColCount) = Betrag End If End With RowCount = RowCount + 1 Loop End With ColCount = ColCount + 1 FName = Dir() Loop End Sub I would be very grateful for every help. Volker |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Importing multiple text files to 1 spreadsheet | Excel Programming | |||
Importing multiple Text files into Excel | Excel Programming | |||
Importing multiple Text files into Excel | Excel Programming | |||
Importing multiple Text files into Excel | Excel Programming | |||
Importing multiple Text files into Excel 2003 | Excel Discussion (Misc queries) |