Supportnet Computer
Planet of Tech

Supportnet / Forum / Tabellenkalkulation

mehrer Arbeitsmappen in eine neue Arbeitsmappe in Tabelle 1 untereinander kopieren





Frage

Hallo, ich habe mehrere EXCEL-Dateien unter einem Ordner "DATEIEN". Diese sollen automatisch in einer neuen Arbeitsmappe "Zusammenfuehrung_25.10.06.xls" in der "Tabelle 1" untereinander weggeschrieben werden. Mit u.s. Makro habe ich es geschaftt, daß alle Dateien in o.g. Arbeitsmappe ünertragen werden, aber jede Datei wird in ein anderes Tabellenblatt ("Tabelle 1(2), Tabelle 1 (3) etc.") geschrieben. Wie kann ich das Makro ändern bzw. ihr könnt es auch ganz neu schreiben, daß alle Dateien im Tabellenblatt 1 untereinander stehen. Danke für die Hilfe. Makro: Sub konsolidierung() Dim Mappe As String Dim i As Integer Const LW = "C:\" Const Pfad = "C:\Betti\DATEIEN\" ´hier stehen die Dateien ChDrive LW ChDir Pfad Application.SheetsInNewWorkbook = 1 Workbooks.Add ActiveWorkbook.SaveAs ("C:\Betti\Dateien\Zusammenfuehrung_25.10.06.xls") Mappe = Dir(Pfad & "*.xls") ChDir (Pfad) Do While Mappe <> "" Workbooks.Open Mappe For i = 1 To Workbooks(Mappe).Sheets.Count Workbooks(Mappe).Sheets(i).Copy Before:=Workbooks("Zusammenfuehrung_25.10.06.xls").Sheets(1) Next i Workbooks(Mappe).Close savechanges:=False Mappe = Dir Loop End Sub

Antwort 1 von coros

Hallo Betti,

mal ungetestet geändert.

Sub konsolidierung()

Dim Mappe As String
Dim i As Integer
Const LW = "C:\"
Rem:hier stehen die Dateien
Const Pfad = "C:\Betti\DATEIEN\"

ChDrive LW
ChDir Pfad

Application.SheetsInNewWorkbook = 1
Workbooks.Add

ActiveWorkbook.SaveAs ("C:\Betti\Dateien\Zusammenfuehrung_25.10.06.xls")

Mappe = Dir(Pfad & "*.xls")
ChDir (Pfad)

Do While Mappe <> ""
Workbooks.Open Mappe

For i = 1 To Workbooks(Mappe).Sheets.Count
Workbooks(Mappe).Sheets(i).Cells.Copy _
Workbooks("Zusammenfuehrung_25.10.06.xls").Sheets(1).Range("A" & Workbooks("Zusammenfuehrung_25.10.06.xls").Sheets(1).Range("A65536").End(xlUp).Offset(1, 0).Row)
Next i

Workbooks(Mappe).Close savechanges:=False
Mappe = Dir

Loop
End Sub

Versuche es erst mal an einer Kopie Deiner Datei, da ich wie schon oben geschrieben habe, das Makro nicht getetstet habe.

Bei Fragen melde Dich bitte wieder.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Ich möchte kostenlos eine Frage an die Mitglieder stellen:


Ähnliche Themen:


Suche in allen vorhandenen Beiträgen: