Arbeitsblätter zusammenführen - mit oder ohne VBA

Hallo Gemeinde,
auf Anraten von WernerB (danke nochmal) hier nochmal ein neuer Thread zu meinem Problem:
Ich habe insgesamt 42 Exceldateien, die, was den Spalten und Zellenaufbau betreffen (Format und Bezeichnungen) absolut identisch sind. Nur die Inhalte sind unterschiedlich.
Ich möchte nun alle 42 Exceldateien in einer neuen zusammenfassen, in der dann alle untereinander stehen und anschließend von mir weiterbearbeitet werden können.
Ich könnte natürlich eine neue Datei öffnen und mit kopieren und einfügen jeweils alle einzelnen Dateien untereinander einkopieren. Da war meine Idee, ob es nicht einen eleganteren Weg gibt (ähnlich wie in Word, wo ich ja auch die Seiten verschiedener Dokumente in einem Worddokument zusammenfassen kann), diese Einzeldateien einfach untereinander in eine einzige schreiben zu lassen.
Wenn alle Stricke reissen, muss ich halt eben mit kopieren und einfügen arbeiten.
Aber vielleicht gibt es ja eine elegantere Möglichkeit.
Im voraus besten Dank! Ein Super-Forum......
Karl-Heinz

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub KarlHeinz() Dim sFile As String, sPath As String Dim WB1 As Workbook, WB2 As Workbook Dim WS1 As Worksheet, WS2 As Worksheet Dim LetzteZeile1 As Long, LetzteZeile2 As Long Application.ScreenUpdating = False Set WB1 = ThisWorkbook Set WS1 = WB1.ActiveSheet sPath = InputBox("Bitte Pfad eingeben: ", "Dateipfad", "C:\Test") If Right(sPath, 1) <> "\" Then sPath = sPath & "\" sFile = Dir(sPath & "*.xls") Do While sFile <> "" Workbooks.Open sPath & sFile Set WB2 = Workbooks(sFile) Set WS2 = WB2.Worksheets(1) LetzteZeile1 = Right(Right(WS1.UsedRange.Address, Len(WS1.UsedRange.Address) - _ InStr(WS1.UsedRange.Address, ":") - 1), Len(Right(WS1.UsedRange.Address, _ Len(WS1.UsedRange.Address) - InStr(WS1.UsedRange.Address, ":") - 1)) - _ InStr(Right(WS1.UsedRange.Address, Len(WS1.UsedRange.Address) - _ InStr(WS1.UsedRange.Address, ":") - 1), "$")) LetzteZeile2 = Right(Right(WS2.UsedRange.Address, Len(WS2.UsedRange.Address) - _ InStr(WS2.UsedRange.Address, ":") - 1), Len(Right(WS2.UsedRange.Address, _ Len(WS2.UsedRange.Address) - InStr(WS2.UsedRange.Address, ":") - 1)) - _ InStr(Right(WS2.UsedRange.Address, Len(WS2.UsedRange.Address) - _ InStr(WS2.UsedRange.Address, ":") - 1), "$")) WS2.Range("A2:AH" & LetzteZeile2).Copy _ WS1.Cells(LetzteZeile1 + 1, 1) WB2.Close False sFile = Dir() Loop Application.ScreenUpdating = True End Sub

Hi Karl-Heinz
Ja bei mir hat es funktioniert. Den 'Beweis' könnte ich bringen in dem ich die fertige Datei anfüge, aber das würde wohl auch nicht weiter helfen.
Es wird jeweils der Bereich aus Blatt 1 der jeweiligen Datei kopiert. Kann es sein, dass du noch weitere Blätter in den Dateien hast.
Vielleicht mal so testen...


Sub KarlHeinz()
Dim sFile As String, sPath As String
Dim WB1 As Workbook, WB2 As Workbook
Dim WS1 As Worksheet, WS2 As Worksheet
Dim LetzteZeile1 As Long, LetzteZeile2 As Long
Application.ScreenUpdating = False
Set WB1 = ThisWorkbook
Set WS1 = WB1.ActiveSheet
sPath = InputBox("Bitte Pfad eingeben: ", "Dateipfad", "C:\Test")
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
sFile = Dir(sPath & "*.xls")
Do While sFile <> ""
Workbooks.Open sPath & sFile
Set WB2 = Workbooks(sFile)
Set WS2 = WB2.Worksheets(1)
LetzteZeile1 = Right(Right(WS1.UsedRange.Address, Len(WS1.UsedRange.Address) - _
InStr(WS1.UsedRange.Address, ":") - 1), Len(Right(WS1.UsedRange.Address, _
Len(WS1.UsedRange.Address) - InStr(WS1.UsedRange.Address, ":") - 1)) - _
InStr(Right(WS1.UsedRange.Address, Len(WS1.UsedRange.Address) - _
InStr(WS1.UsedRange.Address, ":") - 1), "$"))
LetzteZeile2 = Right(Right(WS2.UsedRange.Address, Len(WS2.UsedRange.Address) - _
InStr(WS2.UsedRange.Address, ":") - 1), Len(Right(WS2.UsedRange.Address, _
Len(WS2.UsedRange.Address) - InStr(WS2.UsedRange.Address, ":") - 1)) - _
InStr(Right(WS2.UsedRange.Address, Len(WS2.UsedRange.Address) - _
InStr(WS2.UsedRange.Address, ":") - 1), "$"))
WS2.Range("A2:AH" & LetzteZeile2).Select
End
' Müsste den Tabellenbereich der ersten Datei markieren.
WB2.Close False
sFile = Dir()
Loop
End Sub

Gruss
Chris

Beliebteste Forumthreads (12 Monate)

Arbeitsblätter zusammenführen - mit oder ohne VBA

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

301 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Arbeitsblätter zusammenführen - mit oder ohne VBA

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

301 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread