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