Dokument aus mehreren Dateien zusammenführen

Sub Tabelle_zusammenfassen() Rows("4:" & Rows.Count).ClearContents Dim i As Integer Dim Zusammenfassung As Worksheet Set Zusammenfassung = Worksheets("Zusammenfassung") For i = 2 To Worksheets.Count Set BereichZielTab = Range(Worksheets(i).Range("A4"), Worksheets(i).Cells.SpecialCells( _ xlCellTypeLastCell)) Set LetzteZeileZusammenfassung = Worksheets(1).Cells(Rows.Count, "A").End(xlUp)(2) BereichZielTab.Copy Destination:=LetzteZeileZusammenfassung Next i End Sub

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Hi, ich habe da mal einen Code zum Testen:
Das ganze geht von der Sub "Start" aus. Dann werden im angegebenen Verzeichnis und in Unterverzeichnissen alle Exceldateien nacheinander geöffnet und abgearbeitet. Der Code geht davon aus, dass in den Exceldateien immer das erste Sheet kopiert wird und in der Zieldatei die Daten in das erste Sheet eingefügt werden.
Das Gnaze ist ungetestet, sonst müsstest Du mal Beispieldateien zur Verfügung stellen.


Public Sub Quelldateien(str_start As String)
On Error GoTo fehler
' Deklaration als  Array
Dim str_findDir() As String
Dim str_find As String
Dim lng_zaehler As Long
Dim str_findfile As String
Dim lng_zeile As Long
Dim bol_gefunden As Boolean
Dim str_aktuelles_verzeichnis As String
ChDrive ("C:\")
ChDir (str_start)
str_aktuelles_verzeichnis = str_start
' Findet die erste Excel-datei
str_findfile = Dir("*.xls*", vbNormal)
Do Until str_findfile = ""
' Sucht die gefundene Excel-Datei in der Liste der gültigen Dateien
Workbooks.Open str_findfile
Call Tabelle_zusammenfassen(str_findfile)
Workbooks(str_findfile).Close Savechanges:=False
str_findfile = Dir()
Loop
' Übergang zu den Unterverzeichnissen
lng_zaehler = 0
str_find = Dir("*.*", vbDirectory)
Do Until str_find = ""
' Neudimensionierung, Beibehaltung der vorhandenen Werte
ReDim Preserve str_findDir(lng_zaehler)
' Merken Name Unterverzeichnis in Array
str_findDir(lng_zaehler) = str_find
lng_zaehler = lng_zaehler + 1
' Suche nächstes Unterverzeichnis
str_find = Dir()
Loop
For lng_zaehler = 0 To UBound(str_findDir)
If Dir(str_findDir(lng_zaehler), vbNormal) = "" And Left(str_findDir(lng_zaehler), 1)  "." _
Then
Call Quelldateien(str_start & "\" & str_findDir(lng_zaehler))
ChDrive (str_start)
End If
Next
Exit Sub
fehler:
Select Case Err.Number
Case 76
' Unterverzeichnis nicht gefunden, gehe zu nächstem
Exit Sub
Case Else
MsgBox "Fehler:" & Err.Number & ", Beschreibung: " & Err.Description
End Select
End Sub
Public Sub Start()
Dim str_start As String
Dim str_dateiname As String
Application.ScreenUpdating = False
str_start = "C:\Users\steff\Documents\SAP Export\Zusammenfassungen\ZSD092"
Call Quelldateien(str_start)
Application.ScreenUpdating = True
End Sub
Sub Tabelle_zusammenfassen(str_findfile As String)
Dim i As Long
Dim Quelle As Workbook
Dim LetzteZeileZusammenfassung As Range
Dim BereichZielTab As Range
Set Quelle = Workbooks(str_findfile)
ThisWorkbook.Worksheets(1).Rows("4:" & Rows.Count).ClearContents
Set BereichZielTab = Range(Quelle.Worksheets(1).Range("A4"), Quelle.Worksheets(1).Cells. _
SpecialCells( _
xlCellTypeLastCell))
Set LetzteZeileZusammenfassung = ThisWorkbook.Worksheets(1).Cells(Rows.Count, "A").End(xlUp)(2)
BereichZielTab.Copy Destination:=LetzteZeileZusammenfassung
End Sub

Beliebteste Forumthreads (12 Monate)

Dokument aus mehreren Dateien zusammenführen

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Dokument aus mehreren Dateien zusammenführen

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread