Daten aus mehreren Dateien in eine Tabelle übertr.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Erich,
danke für Deine Nachfrage - ja, alle zu öffnenden Hinzu-Dateien (HinzuDatei1.xls usw.) stehen im gleichen Verzeichnis (Pfad1). Die Zentral.xls (die das Makro enthält) steht steht in Pfad2 und die Datei "Dateienliste.xls" steht in Pfad3.
Die Dateien "Dateienliste.xls" ist beim Programmstart noch nicht geöffnet.
Die Anzahl Quellzeilen: Sowohl bei den "Hinzu-Dateien" mit den Datenzeilen wie auch in der "Dateienliste.xls" ließe sich die Anzahl ermitteln durch den nächstleeren Eintrag, denn Spalte A ist immer gefüllt in einer Zeile. Vielleicht ist noch wichtig: Sowohl in der "Dateienliste.xls" wie auch in den Hinzu-Dateien gibt es eine Überschriftenzeile. In der Zentral.xls, Tabelle1, steht zunächst noch nichts. Wenn es einfacher ist, könnte ich hier einmalig die Überschriftenzeile manuell reinkopieren. Das Programm müsste dann immer von Zeile 2 an bei den Hinzu-Dateien selektieren.
Grüße, Constantin

Hi Constantin,
probier mal


Option Explicit
Sub Sammler()
Dim wksL As Worksheet, lngZ As Long, rngC As Range, lngQ As Long
Dim Calc As XlCalculation
Const strPfL As String = "c:\tmp\exc\"  ' Pfad der Dateienliste.xls - anpassen
Const strPfQ As String = "c:\tmp\"      ' Pfad der Quellmappen      - anpassen
With Application
Calc = .Calculation
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
End With
On Error GoTo XErr
Set wksL = Workbooks.Open(strPfL & "Dateienliste.xls", False, True).Worksheets(1)
With ThisWorkbook.Worksheets(1)
lngZ = .Cells(.Rows.Count, 1).End(xlUp).Row
If Not IsEmpty(.Cells(lngZ, 1)) Then lngZ = lngZ + 1
End With
For Each rngC In wksL.Cells(2, 1). _
Resize(wksL.Cells(wksL.Rows.Count, 1).End(xlUp).Row - 1)
Workbooks.Open strPfQ & rngC, False, True
With ActiveWorkbook.Worksheets(1)
lngQ = .Cells(.Rows.Count, 1).End(xlUp).Row + (lngZ > 1)
If lngQ > 0 Then
.Cells(1, 1 - (lngZ > 1)).Resize(lngQ, 26).Copy _
ThisWorkbook.Worksheets(1).Cells(lngZ, 1)
'  schreibt in Spalte AA den Quelldateinamen:
'           ThisWorkbook.Worksheets(1).Cells(lngZ, 27).Resize(lngQ) = rngC.Value
lngZ = lngZ + lngQ
End If
.Parent.Close False
End With
Next rngC
wksL.Parent.Close False
XErr:
If Err.Number  0 Then MsgBox "Fehler " & Err.Number & vbLf & _
Err.Description, vbCritical, "Sammler"
With Application
.Calculation = Calc
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Beliebteste Forumthreads (12 Monate)

Daten aus mehreren Dateien in eine Tabelle übertr.

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

331 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Daten aus mehreren Dateien in eine Tabelle übertr.

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

331 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread