Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
404to408
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
404to408
404to408
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Tabellen zusammenführen

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.

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

Betreff
Benutzer
Anzeige
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

Anzeige
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

Anzeige
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)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige