Daten aus mehreren Dateien zusammenführen

Hallo Leute
Ich hab wieder mal Urlaub und wollte wieder mal an meiner exceldatei weiterarbeiten.
Hab mich durch verschiedene Beiträge gelesen aber irgendwie schaffe ich das nicht zu realisieren.
Alle Dateien sind gleich aufgebaut nur anderen Namen.
- Endungen .xls, xlsm, xlsx
- Tabelenname "Holzliste Manuell"
- nur Inhalte kopieren da auch Formeln enthalten sind Zeile B7-AC500 und AG7-AO500
- Ziel Datei hat die gleiche Struktur.
es geht mir darum ich hab viele kleine Holzlisten und am ende möchte ich alle Positionen untereinander zusammenführen.
Ich hoffe ihr könnt mir helfen, mit dem auslesen von geschlossenen Dateien habe ich meine Probleme.
Ich hab mal eine Musterdatei angehängt mit dem Auszug der Tabelle, es existieren noch andere Tabellen mit endlichen Formeln und Makros die wäre zu gross.
https://www.herber.de/bbs/user/110193.xls
mfg
Jürgen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub UseFileDialogOpen() Dim lngCount As Long Dim WSZFMA As Worksheet Dim WB As Workbook Dim ws As Worksheet Dim A Dim r r = 1 Set WSZFMA = ThisWorkbook.Worksheets("Tabelle1") With Application.FileDialog(msoFileDialogOpen) .AllowMultiSelect = True .Show For lngCount = 1 To .SelectedItems.Count Set WB = Workbooks.Open(.SelectedItems(lngCount), True, True) Set ws = WB.Worksheets("Holzliste Manuell") With ws.UsedRange If lngCount = 1 Then A = .Value Else A = .Offset(1).Resize(.Rows.Count - 1, .Columns.Count) End If End With WSZFMA.Cells(r, 1).Resize(UBound(A, 1), UBound(A, 2)) = A r = r + UBound(A, 1) WB.Close False Next lngCount End With End Sub

Sub UseFileDialogOpen() Dim lngCount As Long Dim WSZFMA As Worksheet Dim WB As Workbook Dim ws As Worksheet Dim A Dim r r = 7 'erste Zeile wo eingefügt wird Set WSZFMA = ThisWorkbook.Worksheets("Holzliste Manuell") With Application.FileDialog(msoFileDialogOpen) .AllowMultiSelect = True .Show For lngCount = 1 To .SelectedItems.Count Set WB = Workbooks.Open(.SelectedItems(lngCount), True, True) Set ws = WB.Worksheets("Holzliste Manuell") With ws.Range("B7:AO500") 'Bereich wo kopiert wird If lngCount = 1 Then A = .Value Else A = .Resize(.Rows.Count - 1, .Columns.Count) ' das müsste das ermitteln der letzten _ zeile sein End If End With WSZFMA.Cells(r, 2).Resize(UBound(A, 1), UBound(A, 2)) = A r = r + UBound(A, 1) WB.Close False Next lngCount End With End Sub

Sub UseFileDialogOpen() Dim lngCount As Long Dim lz As Long Dim WSZFMA As Worksheet Dim WB As Workbook Dim ws As Worksheet Dim A Dim r r = 7 'erste Zeile wo eingefügt wird Set WSZFMA = ThisWorkbook.Worksheets("Holzliste Manuell") With Application.FileDialog(msoFileDialogOpen) .AllowMultiSelect = True .Show For lngCount = 1 To .SelectedItems.Count Set WB = Workbooks.Open(.SelectedItems(lngCount), True, True) Set ws = WB.Worksheets("Holzliste Manuell") With ws.Range("B7:AO500") 'Bereich wo kopiert wird If lngCount = 1 Then A = .Value Else lz = .Cells(.Rows.Count, "B").End(xlUp).Row A = .Resize(lz + 1, .Columns.Count) ' vielleicht mit lz + 1 - oder lz - 1 End If End With WSZFMA.Cells(r, 2).Resize(UBound(A, 1), UBound(A, 2)) = A r = r + UBound(A, 1) WB.Close False Next lngCount End With End Sub

Hallo Leute
Endlich hab es geschafft.
Alles funktioniert wie es soll, das einzige was komisch ist, es funktioniert nur wenn ich das Makro in der Tabelle Holzliste Manuell habe.
Wenn ich es in einem Modul liegen hab dann macht er irgendwas aber nicht das was es soll.
Per Commandbutton, oder was ich wollte von einer Userform aus per Makro starten klappt nicht.
Aber ich muss gestehen das habe ich noch nie kapiert, warum die VBA Code es einmal im Modul geht und einmal nicht.
mfg
Jürgen

Sub Sammelholzlisten_import()
Application.ScreenUpdating = False
If MsgBox("Bitte die Holzlisten auswählen, sie werden alle darunter eingefügt", vbOKCancel, " _
Holzlisten zusammenführen") = vbOK Then
'MsgBox "OK"
Else
Exit Sub
End If
Dim lngCount As Long
Dim WSZFMA As Worksheet
Dim WB As Workbook
Dim ws As Worksheet
Dim A
Dim r
r = 1
Set WSZFMA = ThisWorkbook.Worksheets("Holzliste Manuell")
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = True
.Show
For lngCount = 1 To .SelectedItems.Count
Set WB = Workbooks.Open(.SelectedItems(lngCount), True, True)
Set ws = WB.Worksheets("Holzliste Manuell")
With ws.Range("B7:AO500") 'Bereich wo kopiert wird
If lngCount = 1 Then
A = .Value
Else
A = .Resize(.Rows.Count - 1, .Columns.Count)
End If
End With
WSZFMA.Cells(Cells(Rows.Count, 3).End(xlUp).Row + 1, 2).Resize(UBound(A, 1), UBound(A, 2) _
) = A
r = r + UBound(A, 1)  ' sucht die letzte Zeile in spalte 3
WB.Close False
Next lngCount
End With
Application.ScreenUpdating = True
End Sub

Beliebteste Forumthreads (12 Monate)

Daten aus mehreren Dateien zusammenführen

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

315 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Daten aus mehreren Dateien zusammenführen

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

315 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread