Gesamttabelle aus mehreren Einzeltabellen automatisch erstellen

24/11/2009 - 22:46 von friedhelm | Report spam
Hallo und guten Tag,

ich arbeite mit Office 2007 und habe folgendes Problem:

Von mehreren Mitarbeitern arbeitet jeder mit einer eigenen Tabelle, die auf
dem Netzlaufwerk abgelegt ist.
Ich möchte nun diese "kleinen" Tabellen in einer "großen" zusammenfassen und
zwar so, dass der Inhalt der einzelnen automatisch in die Gesamttabelle
übertragen wird.
Hierzu habe ich keinerlei Idee.
Ich gehe davon aus, dass es hilfreich ist, dass die Einzeltabellen alle die
gleichen Spalten aufweisen.

Ich hoffe, ihr könnt meine Beschreibung nachvollziehen.

Vielen Dank; werde jeden Tipp probieren und natürlich auch wieder berichten

Grüße
Friedhelm
 

Lesen sie die antworten

#1 Andreas Killer
25/11/2009 - 09:20 | Warnen spam
friedhelm schrieb:

Ich möchte nun diese "kleinen" Tabellen in einer "großen" zusammenfassen und
zwar so, dass der Inhalt der einzelnen automatisch in die Gesamttabelle
übertragen wird.


Der Code muss in ein normales Modul, wie's geht steht hier:
http://www.online-excel.de/excel/si....php?fD#s2

Ich gehe davon aus, dass es hilfreich ist, dass die Einzeltabellen alle die
gleichen Spalten aufweisen.


Wenn es nur um das blinde Kopieren geht ist es wurscht. Für Deine
Daten ist es aber sinnvoll das nicht nur die Anzahl Spalten, sondern
auch deren Position gleich ist, sondern landet die Spalte mit den
Äpfel unter denen mit den Birnen.

Andreas.

Sub ZusammenKopieren()
'Kopiert alle Blàtter in das aktuelle Blatt
Dim WS As Worksheet, Dest As Range
'Bei Überschriften auf 2 àndern
Const ErsteZeile = 1
'Durchlaufe alle Blàtter
For Each WS In Worksheets
'Ist es dieses Blatt?
If WS.Name <> ActiveSheet.Name Then
'Letzte Zelle in diesem Blatt bestimmen
Set Dest = SheetLastCell
'Nàchste Zeile, Spalte A
Set Dest = Cells(Dest.Row + 1, 1)
'Daten kopieren
WS.Range(WS.Cells(ErsteZeile, 1), SheetLastCell(WS)) _
.Copy Dest
End If
Next
End Sub

Private Function SheetLastCell(Optional S As Worksheet) As Range
'Liefert die letzte verwendete Zelle der Tabelle
Dim R As Range, C As Range
If S Is Nothing Then Set S = ActiveSheet
Set R = S.Cells.SpecialCells(xlCellTypeLastCell)
If IsEmpty(R) And Not R.Address = Cells(1, 1).Address Then
Set C = S.Cells.Find("*", After:=R, SearchOrder:= _
xlByColumns, SearchDirection:=xlPrevious)
If C Is Nothing Then
Set SheetLastCell = S.Cells(1, 1)
Else
Set R = S.Cells.Find("*", After:=R, SearchOrder:= _
xlByRows, SearchDirection:=xlPrevious)
Set SheetLastCell = S.Cells(R.Row, C.Column)
End If
Else
Set SheetLastCell = R
End If
End Function

Ähnliche fragen