Tabellen zusammenführen

Question

Hallo zusammen,

ich melde mich mal wieder, weil sich jetzt wieder etwas geändert hat. Ich bin am verzweifeln- einmal funktionierts - dann wieder nicht!

Problem: Mehrere Exceltabelle in einer zusammenführen.
Alle Dateien liegen im selben Ordner.
der auszulesende Bereich ist B 5:100

Dieser soll von allen Exceltabellen ausgelesen werden und in einer Auswertungstabelle zusammengeführt werden. Jetzt aber als Reihen untereinander; beginnend bei A3

Das Programm soll unter Excel 2003 laufen.

Jetzt könnte ich mir denken, dass ihr meinen Versuch sehen wollt. Habe es schon mit dem FOR Befehl versucht, mit einer If schleife, mit und ohne application.filesearch.

Ich habe jetzt so lange darin herumgefuscht, dass man das Programm am Besten frisch aufbaut.

Ich hoffe ihr könnt mir mal wieder helfen - sind ja viele super Members hier ;)

Vielen lieben Dank

Matthias

Answer 1

hi mathias ^^

vielleicht so :-)

gruss nighty

Option Explicit
Sub DateienLesen()
Call EventsOff
Dim Zaehler1 As Long
Dim DateiName As String, Meldung As String
DateiName = Dir("C:\Temp\" & "*.xls") 'pfad anpassen
ReDim ArrayNeu(1, 96) As Variant
ReDim ArrayA(96, 1) As Variant
ArrayNeu() = Range(Cells(1, 1), Cells(1, 96))
Do While DateiName <> ""
If ThisWorkbook.Name <> DateiName Then
Workbooks.Open Filename:="C:\Temp\" & DateiName 'pfad anpassen
Workbooks(DateiName).Worksheets("Tabelle2").Activate 'worksheetname anpassen
ArrayA() = Range("B5:B100")
For Zaehler1 = 1 To 96
ArrayNeu(1, Zaehler1) = ArrayA(Zaehler1, 1)
Next Zaehler1
With ThisWorkbook.Worksheets("Tabelle2") 'worksheetname anpassen
.Range(.Cells(.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row + 1, 96)) = ArrayNeu()
Workbooks(DateiName).Close
DateiName = Dir
End With
End If
Loop
Call EventsOn
End Sub

Public Sub EventsOff()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub

Public Sub EventsOn()
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub