mehreren Dateien zu einer zusammenfassen

Hallo zusammen,
hab bzgl. dieses Themas schon einmal um Hilfe gebeten, aufgrund meiner mangelnden VBA-Kenntnisse jedoch keinen Erfolg gehabt... Deshalb versuch ich nun nochmal genauer zu werden.
Ausgangslage ist die, dass ich 30 verschiedene Dateien habe, die vom Aufbau her zwar alle gleich sind, allerdings mit verschiedenen Werten gefüllt.
Außerdem liegen diese leider in unterschiedlichen Orten und Ordnern.
Meine Aufgabe ist es nun die verschiedenen Dateien zusammen zu führen um sie zu vergleichen. Jedoch immer nur eine Zeile von jeder Datei und die nachfolgenden sollen Dann darunter geschrieben usw... Die Zeile der Quelldateien geht immer von D40 bis AZ40.
Habt ihr eine Idee wie ich das lösen könnte?
Eine beispielhafte Datei kann ich leider nicht hochladen, da das Problem beruflich ist.
Ich stelle es mir vielleicht so vor, dass man einmal für jede Datei den Pfad angibt und der jeweiligen Zeile in der Zieldatei zuweist.(Vielleicht sogar in einem Pfadfenster wie man es z.b. beim Speichern von Dateien gewohnt ist) Anschließend macht man einen Button "aktualisieren" der bei Betätigung einmal die Einlese-Funktion für alle Datei ausführt.
Ich hoffe Ihr könnt mir weiterhelfen, bin langsam echt am verzweifeln...:/
Vielen Dank schon mal im voraus :)

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Nickelwerner() Dim WBQ as workbook 'Quelle Dim WSZ as worksheet 'Ziel Set wsz = activesheet sPath = "c:\tmp\" '>>>>>>> anpassen sFile = dir(sPath & "*.xlsx") Do while sFile "" lr = wsz.cells(rows.count, 1).end(xlup).row + 1 Set wbq = workbooks.open(sPath & sFile) Wbq.sheets(1).range("D40:AZ40").copy wsz.cells(lr,1) Wbq.close 0 sFile = dir Loop End sub

Hallo,
wenn du das Makro anklickst geht ein Fenster auf, da kannst Du die Dateien anklicken die Du Kopiert haben willst diese werden dann in die Tabelle Kopiert. Vorraussetzung ist das die Strukturen der Dateien alle gleich sind
LG
Olaf


Public Sub Daten_mehrerer_Dateien_zusammenfuehren()
On Error GoTo errExit
Dim WBQ As Workbook
Dim WBZ As Workbook
Dim varDateien As Variant
Dim lngAnzahl As Long
Dim lngLastQ As Long
Set WBZ = ActiveWorkbook
'Altdaten auf Zielblatt löschen
WBZ.Worksheets(1).Range("A2:IV65536").ClearContents
varDateien = _
Application.GetOpenFilename("Datei (*.xls),*.xls", False, "Bitte gewünschte Datei(en) markieren" _
, False, True)
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
For lngAnzahl = LBound(varDateien) To UBound(varDateien)
Set WBQ = Workbooks.Open(Filename:=varDateien(lngAnzahl))
lngLastQ = WBQ.Worksheets(1).Range("A65536").End(xlUp).Row
WBQ.Worksheets(1).Range("A2:Z" & lngLastQ).Copy _
Destination:=WBZ.Worksheets(1).Range("A" & WBZ.Worksheets(1).Range("A65536").End(xlUp).Row +  _
1)
WBQ.Close
Next
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
MsgBox "Es wurden " & UBound(varDateien) & " Dateien zusammengefügt.", 64
Exit Sub
errExit:
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
If Err.Number = 13 Then
MsgBox "Es wurde keine Datei ausgewählt"
Else
MsgBox "Es ist ein Fehler aufgetreten!" & vbCr _
& "Fehlernummer: " & Err.Number & vbCr _
& "Fehlerbeschreibung: " & Err.Description
End If
End Sub

Public Sub Daten_mehrerer_Dateien_zusammenfuehren() On Error GoTo errExit Dim WBQ As Workbook Dim WBZ As Workbook Dim varDateien As Variant Dim lngAnzahl As Long Dim lngLastQ As Long Set WBZ = ActiveWorkbook 'Altdaten auf Zielblatt löschen WBZ.Worksheets(1).Range("A2:IV65536").ClearContents varDateien = _ Application.GetOpenFilename("Datei (*.xls),*.xls", False, "Bitte gewünschte Datei(en) markieren" _ , False, True) With Application .ScreenUpdating = False .EnableEvents = False .Calculation = xlCalculationManual End With For lngAnzahl = LBound(varDateien) To UBound(varDateien) Set WBQ = Workbooks.Open(Filename:=varDateien(lngAnzahl)) lngLastQ = WBQ.Worksheets(1).Range("A65536").End(xlUp).Row WBQ.Worksheets(1).Range("A2:Z" & lngLastQ).Copy _ Destination:=WBZ.Worksheets(1).Range("A" & WBZ.Worksheets(1).Range("A65536").End(xlUp).Row + _ 1) WBQ.Close Next With Application .ScreenUpdating = True .EnableEvents = True .Calculation = xlCalculationAutomatic End With MsgBox "Es wurden " & UBound(varDateien) & " Dateien zusammengefügt.", 64 Exit Sub errExit: With Application .ScreenUpdating = True .EnableEvents = True .Calculation = xlCalculationAutomatic End With If Err.Number = 13 Then MsgBox "Es wurde keine Datei ausgewählt" Else MsgBox "Es ist ein Fehler aufgetreten!" & vbCr _ & "Fehlernummer: " & Err.Number & vbCr _ & "Fehlerbeschreibung: " & Err.Description End If End Sub

Sub Test123() Dim pfad As Workbook Dim Ziel As Worksheets Set pfad = Application.GetOpenFilename Set Ziel = ActiveSheet With Application .ScreenUpdating = False .EnableEvents = False .Calculation = xlCalculationManual End With pfad.Worksheets(1).Range("D40:CT40").Copy Ziel.Workseheets(1).Cells("G5").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Ziel.Workseheets(1).Cells("G5").PasteSpecial Paste:=xlPasteValues pfad = Nothing End Sub

Beliebteste Forumthreads (12 Monate)

mehreren Dateien zu einer zusammenfassen

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

mehreren Dateien zu einer zusammenfassen

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread