Tabellen zusammenführen

Forumthread: Tabellen zusammenführen

Hansueli

Hallo zusammen,
Ich möchte folgende Aufgabe automatisieren oder vereinfachen.
Habe 20 Tabellen als einzelne Dateien die alle die gleichen Spalten Überschriften haben aber eine unterschiedliche Anzahl Zeilen aufweisen (bis 300). Alle Dateien befinden sich im selben Ordner. Bis jetzt habe ich die einzelnen Tabellen von Hand in eine Tabelle kopiert und anschliessend weiter bearbeitet. Die Tabellen enthalten Gültigkeitsprüfungen und recht komplexe Wenn, sowie Summewenn Formeln. Wie müsste ein Makro aussehen? Komme mit dem Makro Recorder nicht weiter.
Vielen Dank für einen tollen Tipp.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

AW: Tabellen zusammenführen

ransi

Hallo Hansueli
Besteht die Möglichkeit die 20 Tabellen auf 20 Tabellenblätter in einer einzigen Datei unterzubringen?
Dann wäre es bedeutend einfacher die Werte auf einem Tabellenblatt unterzubringen.

AW: Tabellen zusammenführen

Hansueli

Hi Ransi
Ja das ist möglich, diese Arbeit kann ich mit einem Makro erledigen.

AW: Tabellen zusammenführen

Christoph

Hallo Hansueli,
das folgende Makro könnte dir weiterhelfen.
Es werden aus ALLEN xls-Dateien aus dem Verzeichnis "D:\Test\" die Tabelle1 kopiert
und in deine Datei (jene, aus der du dieses Makro startest) in Tabelle1 eingefügt.
Es fehlt evt noch ne Fehlerabfangung, müsste aber soweit laufen.
Das Laufwerks und den Pfad musst du noch entsprechend anpassen.
Gruß
Christoph
('ne rückmeldung wäre nett)
Option Explicit


Sub Dateien_oeffnen()
'Christoph Meffert, 28.03.04
Dim TmpDatei As String, Pfad As String
Dim LRow1 As Integer, LRow2 As Integer
Dim wsMaster As Worksheet
Set wsMaster = ThisWorkbook.Sheets("Tabelle1")
ChDrive "d"
ChDir "D:\Test\"
TmpDatei = Dir("D:\Test\*.xls")
Application.ScreenUpdating = False
Do While TmpDatei <> ""
LRow1 = wsMaster.Cells(Rows.Count, 1).End(xlUp).Row
Workbooks.Open TmpDatei
LRow2 = Workbooks(TmpDatei).Sheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row
Workbooks(TmpDatei).Sheets("Tabelle1").Rows("1:" & LRow2).Copy wsMaster.Cells(LRow1 + 1, 1)
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True
TmpDatei = Dir()
Loop
Application.ScreenUpdating = True
End Sub

AW: Tabellen zusammenführen

Hansueli

Hallo Christoph,
Vielen Dank, das Makro läuft perfekt, musste nur den Pfad anpassen.
Nochmals vielen Dank
Hansueli

Danke für die Rückmeldung (o.T.)

30.03.2004 14:05:14

Christoph

AW: Tabellen zusammenführen

ransi

Hallo Hansueli
Hab mir auch so meine Gedanken gemacht zu deinem Problem.
Füge mal in die datei mit den 20 Blättern ein blatt an position 1 ein, und nenn das Zusammenfassung.
In zeile 1 Kopierst du dann die Überschriften.
Wenn du jetzt diese


Sub startest, sollte alles so sein wie du es haben möchtest.
Is zwar nicht so elegant wie das vom christoph, läuft aber bei mir.
Option Explicit

Sub Zusammenfassung()
Dim br As Long 'benutzte Zeilen in Zusammenfassung
Dim bc As Long 'benztzte Spalten in Zusammenfassung
Dim u As Integer 'benutzte Zeilen in Datenblättern
Dim i As Integer 'Index für Datenblatt
Dim qbereich
Dim zbereich
br = Worksheets("zusammenfassung").UsedRange.Rows.Count 'alten bereich in Tabelle "zusammenfassung" ermitteln
bc = Worksheets("zusammenfassung").UsedRange.Columns.Count
With ActiveWorkbook
.Worksheets("zusammenfassung").Activate
Range(Cells(2, 1), Cells(br, bc)).Select
Selection.ClearContents 'alte Werte löschen
For i = 2 To Worksheets.Count 'Datenbereich in Tabellen ermitteln
Worksheets(i).Select
u = Worksheets(i).UsedRange.Rows.Count
Set qbereich = .Worksheets(i).Range(Cells(u, 256), Cells(2, 1))
Set zbereich = Worksheets(1).Cells(Rows.Count, "A").End(xlUp)(2) 'Zielbereich ermitteln
qbereich.Copy Destination:=zbereich
Next
Worksheets("zusammenfassung").Activate
Range("a1").Select
End With
End Sub

AW: Tabellen zusammenführen

29.03.2004 20:53:57

Hansueli

Hallo Ransi,
Deine Lösung läuft ebenfalls perfekt. Du hast mir mit deinem Weg ein 2tes ähnliches Problem lösen geholfen. Habe dein Makro noch um folgendes erweitert
Sheets("Tabelle2").Select
Range("A1:F1").Select
Selection.Copy
Sheets("Zusammenfassung").Select
ActiveSheet.Paste
Jetzt werden die Überschriften ebenfalls erstellt.
Nochmals vielen Dank
Ihr seid Super!!!!!
Gruss Hansueli

AW: Tabellen zusammenführen

ransi

Freut mich! (o.T.)

Beliebteste Forumthreads (12 Monate)

Forumthread: Tabellen zusammenführen

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

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread