Daten zusammenführen

Habe folgende Aufgabenstellung:
Ich muss Daten aus verschiedenen Excel-Dateien, welche sich alle im gleichen Ordner befinden, in einer übergeordneten Datei zusammenführen.
Die übergeordnete Datei ist die Jahrestabelle (Jahr2114.xls)
Die Datenquellen sind Monatstabellen. Jan2014.xls, Feb2014.xls usw.
Die Monatstabellen sind immer gleich aufgebaut.
In Jan2014.xls gibt es die Tabellenblätter: JanGes, 1.1, 1.2, 1.3, 1.14
In Feb2014.xls gibt es die Tabellenblätter: FebGes, 2.1, 2,2, 2,3, 2,8
usw.
Im Tabellenblatt xxxGes werden Informationen aus den Tabellenblättern
x.1 x.2 bis x.n gesammelt.
Für jedes der Tabellenblätter x.1 bis x.n gibt es in xxxGes eine Zeile
Dh. in xxGes sind ab Zeile 5 in Spalte B bis Spalte H die Informationen aus den nachfolgenden Tabellenblättern
Die Anzahl der Zeilen ist unterschiedlich weil die Anzahl der Tabellenblätter unterschiedlich ist.
Somit sind die Informationen in JanGes in den Zeilen 5 bis 19 und
in FebGes in den Zeilen 5 bis 13.
(JanGes, FebGes, MarGes, usw sind in unterschiedlichen Tabellen)
In der jeweils letzten Zeile werden die Zahlen aus den Spalten summiert.
Bis hierhin ist alles mit SVERWEIS , INDIREKT etc. gelöst
Jetzt mein Problem:
Wie bereits beschrieben sollen die Werte aus xxGes in der Jahrestabelle zusammengeführt werden.
Wäre die Anzahl der Zeilen in den Monatstabellen gleich, und würden alle Monatstabellen existieren könnte man wieder über SVERWEIS das Tabellenblatt 2014Ges in der Jahrestabelle beschreiben.
Aber im Tabellenblatt 2014Ges sollen ab Zeile 5 Spalte B bis H (gleicher Aufbau wie in den Monatstabellen) die Daten fortlaufend in den Zeilen eingetragen werden.
Für Januar Zeile 5 bis 19
Für Februar Zeile 20 bis 28
usw. bis Zeile xxx
In der Letzten Zeile (xxx+1) soll dann wieder in den Spalten B bis H summiert werden.
Die Struktur der Tabellenblätter einschl Summierung in der letzten Zeile ist immer gleich.
Ich habe aktuell keinen Ansatz dafür, wie ein Makro aussehen muss, das Zeilen aus verschiedenen Tabellen importiert und einfügt, wobei die Anzahl der Zeilen unbekannt ist.
Das gesamte Tabellenblatt zu exportieren scheint mir auch nicht sinnvoll zu sein.
Evtl. kann mir ja jemand eine Hilfestellung geben.
Vielen Dank im voraus
Uwe

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Aktualisieren() 'Datei öffnen Workbooks.Open (ThisWorkbook.Path & "\" & "QUELLE.xls") 'Prüfen, ob bereits vorhanden If WorksheetFunction.CountIf(Workbooks("ZIEL.xls").Sheets("Tabelle1").Range("H:H"), Range("H4"). _ Value) = 0 Then 'Kopieren Range("A4:H10").Copy 'Werte in Gesamtdatei einfügen Workbooks("ZIEL.xls").Sheets("Tabelle1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0). _ PasteSpecial Paste:=xlPasteValues End If 'Fenster schließen Workbooks("QUELLE.xls").Close End Sub

Sub Import() Dim strImportdatei As String Dim lngI As Long lngI = 2 ' Schleife von A2 bis in Spalte A nichts mehr drin steht. Do While ThisWorkbook.Worksheets("Tabelle1").Cells(lngI, 1) "" strImportdatei = ThisWorkbook.Worksheets("Tabelle1").Cells(lngI, 1) ' Prüfen ob Datei vorhanden 'If Dir(strImportdatei) "" Then If Dir(strImportdatei) = "" Then Application.DisplayAlerts = False ' Datei öffnen Workbooks.Open (ThisWorkbook.Path & "\" & strImportdatei) ' Nun die Daten auslesen. ThisWorkbook.Worksheets("Tabelle1").Cells(lngI, 2) = ActiveWorkbook.Worksheets(1).Cells( _ _ 1, 3) ' Datei wieder schließen. ActiveWorkbook.Close Application.DisplayAlerts = True Else ' Datei nicht vorhanden, dann halt ThisWorkbook.Worksheets("Tabelle1").Cells(lngI, 2) = "Fehler: Datei existiert nicht" End If lngI = lngI + 1 Loop End Sub

Sub Kopieren() Dim wsQuelle, wsZiel As Worksheet Dim lngLastQ As Long, lngLastZ As Long Set wsQuelle = ThisWorkbook.Worksheets("Tabelle1") ' hier muß der Tabellenname rein Set wsZiel = ThisWorkbook.Worksheets("Tabelle2") lngLastQ = wsQuelle.Cells(Rows.Count, 1).End(xlUp).Row 'letzte gefüllte in "A" von Quelle lngLastZ = wsZiel.Cells(Rows.Count, 1).End(xlUp).Row 'letzte gefüllte in "A" von Ziel If lngLastQ > 2 Then wsQuelle.Range("A3:S" & lngLastQ).Copy wsZiel.Range("A" & lngLastZ + 1) End If End Sub

Option Explicit Sub Kopieren() Dim strPfad, strDateiname, strPfadUndDatei As String Dim lngLastQ, lngLastZ As Long strPfad = "C:\XXXXX\XXXXX\XXXXX\XXXXX\" 'Pfad des Ordners, in dem die _ einzulesenden Dateien liegen strDateiname = Range("A1").Value 'in Zelle A1 des Blattes, von wo _ aus der Code ausgeführt wird, muss der Name der_ ' einzulesenden Datei stehen. Also _ bspw. Jan2014 strPfadUndDatei = strPfad & strDateiname & ".xls" 'für ".xls" muss der Dateityp der _ einzulesenden Dateien eingesetzt werden 'Öffnet die Quelldatei Workbooks.Open Filename:=strPfadUndDatei lngLastQ = Worksheets(1).Cells(Rows.Count, 2).End(xlUp).Row 'letzte gefüllte Zeile in Spalte "B" _ der Quelldatei Range("B5:H" & lngLastQ).Select Selection.Copy Windows("Jahr2014").Activate 'Wechselt wieder in die _ Jahrestabelle, wo alle Datein eingefügt werden sollen lngLastZ = Worksheets(1).Cells(Rows.Count, 2).End(xlUp).Row 'letzte gefüllte Zeile in Spalte "B" _ der Zieldatei Range("B" & lngLastZ + 1).Paste 'Schließt die Quelldatei und springt in Zelle A1 der Zieldatei Windows(Dateiname & ".xls").Activate ActiveWorkbook.Save ActiveWindow.Close Windows("Jahr2014").Worksheets(1).Range("A1").Select End Sub

Sub Kopieren() Dim strPfad, strDateinameQuelle, strDateinameZiel, strPfadUndDatei As String Dim lngLastQ, lngLastZ As Long 'Pfad des Ordners, in dem die einzulesenden Dateien liegen strPath = Left(strPath, InStr(1, strPath, strSearch) + Len(strSearch)) 'in Zelle A1 des Blattes, von wo aus der Code ausgeführt wird, muss der Name der einzulesenden _ Datei stehen. _ Also bspw. Jan2014 strDateinameQuelle = Range("A1").Value strPfadUndDatei = strPfad & strDateinameQuelle & ".xls" 'strDateinameZiel = ActiveWorkbook.Name 'Öffnet die Quelldatei Workbooks.Open (ThisWorkbook.Path & "\" & strDateinameQuelle & ".xls") lngLastQ = Worksheets(1).Cells(Rows.Count, 2).End(xlUp).Row 'letzte gefüllte Zeile in Spalte "B" _ _ der Quelldatei Range("B5:H" & lngLastQ).Select Selection.Copy Windows(ThisWorkbook.Name).Activate 'Windows("Jahr2014.xls").Activate 'Wechselt wieder in die Jahrestabelle, wo alle Datein eingefügt werden sollen lngLastZ = Worksheets(1).Cells(Rows.Count, 2).End(xlUp).Row 'letzte gefüllte Zeile in Spalte "B" _ _ der Zieldatei Range("B" & lngLastZ + 0).Select ActiveSheet.Paste 'Schließt die Quelldatei und springt in Zelle A1 der Zieldatei Windows(strDateinameQuelle & ".xls").Activate ActiveWorkbook.Close Windows(ThisWorkbook.Name).Activate ActiveSheet.Range("A1").Select End Sub

Hallo Marco,
habe lange getüftelt, aber jetzt ist das Makro fertig.
Danke für deine Vorarbeit.

Sub Import_von_Monats_Aufmass()
'dieses Makro importiert Daten aus der Monatsdatei z.B. Aug2014 aus Tabellenblatt Aufmass _
in die Arbeitsmappe Gesamt dieser Datei.
'Der Quellbereich befindet sich im Arbeitsblatt Aufmass ab Zeile 6 zwischen den Spalten B und  _
AB
'In Zelle A1 von Gesamt muss der Name der Quellmappe eingetragen werden (Aug2014)
'Die eingelesenen Daten werden 2 Zeilen oberhalb der letzten belegten Zeile angefügt.
'--------------------------- 06.09.2014    Uwe  -------------------------------------
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Dim strPfad, strDateinameQuelle, strPfadUndDatei As String
Dim lngLastQ, lngLastZ, Offset As Long
Dim EZ As Integer  ' Nummer der ersten Zeile der Quelldatei
Dim LZ As Integer  ' Nummer der letzten Zeile der Quelldatei
Dim s As String  ' Adresse des markierten Bereichs der Quelldatei
Dim Länge As Integer 'Anzahl der zu kopierdenden Zeilen
'Pfad des Ordners, in dem die einzulesenden Dateien liegen
strPath = Left(strPath, InStr(1, strPath, strSearch) + Len(strSearch))
'in Zelle A1 des Blattes, von wo aus der Code ausgeführt wird, muss der Name der einzulesenden  _
Datei stehen. _
Also bspw. Aug2014
strDateinameQuelle = Range("A1").Value
strPfadUndDatei = strPfad & strDateinameQuelle & ".xls"
'Quelldatei öffnen und Anzahl der einzulesenden zeilen errechnen
Workbooks.Open (ThisWorkbook.Path & "\" & strDateinameQuelle & ".xls")
lngLastQ = Worksheets("Aufmass").Cells(Rows.Count, 2).End(xlUp).Row 'letzte gefüllte Zeile in  _
Spalte "B" _
der Quelldatei
Range("B6:AB" & lngLastQ - 1).Select ' die letzten zwei Zeilen werden nicht kopiert
'Adressen der Quelldatei auslesen
s = Selection.Address
EZ = Range(s).Row ' erste selektierte Zeile in der Quelldatei
LZ = Range(s).Row + Range(s).Rows.Count - 1 'letzte selektierte Zeile in der Quelldatei
Länge = LZ - EZ    ' Rechenwert in integer
Offset = CLng(Länge) 'Anzahl der einzulesenden Zeilen als long
' Zieldatei öffnen und Leerzeilen einfügen
Windows(ThisWorkbook.Name).Activate
lngLastZ = Worksheets("Gesamt").Cells(Rows.Count, 2).End(xlUp).Row 'letzte gefüllte Zeile in  _
Spalte "B" der Zieldatei
Dim LZZ As Integer   'Letzte zeile der Zieldatei
Dim EZZ As Integer   'erste Zeile der Zieldatei in der eingelesen werden soll
EZZ = lngLastZ + 1  ' ab dieser Zeile der Zieldatei soll der Datenblock eingefügt werden
LZZ = EZZ + Offset + 1 ' Bis zu dieser Zeile sollen entsprechen der Länge des Datenblocks neue  _
Zeilen eingefügt werden
'------- Leerzeilen einfügen in der Zieldatei einfügen ---------------------
Dim y As Integer    ' Schleifenzähler für einzufügende Leerzeilen
With ThisWorkbook.Worksheets("Gesamt")
For y = EZZ To LZZ
.Cells(y, 1).Select
Selection.EntireRow.Insert
Next y
End With
'------  aus Quelldatei Datenblock holen --------------
'Öffnet die Quelldatei
Workbooks.Open (ThisWorkbook.Path & "\" & strDateinameQuelle & ".xls")
lngLastQ = Worksheets("Aufmass").Cells(Rows.Count, 2).End(xlUp).Row 'letzte gefüllte Zeile in  _
Spalte "B" _
der Quelldatei
Range("B6:AB" & lngLastQ + 0).Select ' die letzten zwei Zeilen werden nicht kopiert
Selection.Copy
Windows(ThisWorkbook.Name).Activate
'Wechselt wieder in die Zieltabelle, wo alle Datein eingefügt werden sollen
lngLastZ = Worksheets("Gesamt").Cells(Rows.Count, 2).End(xlUp).Row 'letzte gefüllte Zeile in  _
Spalte "B" der Zieldatei
Range("B" & EZZ + 0).PasteSpecial Paste:=xlValues 'Werte kopieren
Range("B" & EZZ + 0).PasteSpecial Paste:=xlFormats 'Formate kopieren
'Range("B" & lngLastZ + 1).Select   'alles
'ActiveSheet.Paste                  'einschl Formeln kopieren
Application.CutCopyMode = False
'Schließt die Quelldatei und springt in Zelle A1 der Zieldatei
Windows(strDateinameQuelle & ".xls").Activate
'Application.DisplayAlerts = False
ActiveWorkbook.Close
Windows(ThisWorkbook.Name).Activate
ActiveSheet.Range("A1").Select
ActiveWorkbook.Save
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub

mit freundlichen Grüßen
Uwe

Beliebteste Forumthreads (12 Monate)

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread