Datensätze in Excel aus versch. Datenblättern automatisch zusammenführen

Question

Hallo zusammen!

Ich möchte (gleichartige) Datensätze aus verschieden Datenblättern eines Excel-Sheets in einem weiteren Datenblatt zusammenfassen (reihen, aggregieren), sodass
eine Reihe an Datensätzen (automatisch) entsteht.

z.B.
Datenblatt 1:
Gruppe A - 12.09.09 - Kosten: 200,-
Gruppe A - 13.09.09 - Kosten: 100,-

Datenblatt 2:
Gruppe C- 12.09.09 - Kosten: 80,-

Aufgabe: Aggregier die Datensätze automatisch in Datenblatt D (nach Datum sortiert)
Gruppe A - 12.09.09 - Kosten: 200,-
Gruppe C- 12.09.09 - Kosten: 80,-
Gruppe A - 13.09.09 - Kosten: 100,-

Also:
Füge Datensatz des Datenblattes xy automatisch das Datenblatt D ein
und sortiere nach Datum.

Ich möchte dies mit Excel lösen.

Vielen Dank vorab für die Hilfe.

Answer 1

Hallo,

dass kann man via VBA realisieren. Allerdings benötigt man dazu mehr Infos wie die Datei aufgebaut ist. Besser noch wäre eine Beispieldatei, da man dann sofort die richtige Struktur der Datei hat.
Eine Beispieldatei kann z.B. bei http://rapidshare.com hochgeladen werden. Man erhält dann einen Link, den man dann hier posten muss, damit wir die Datei downloaden können.

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

Answer 2

hi all ^^

ein beispiel :-)

gruss nighty

3 Worksheets

Worksheets 1 + 2 spalten a+b+c daten,spalte b datum

zusammenfuehrung nach Worksheets 3 mit anschliessender sortierung

Option Explicit
Sub Sammeln()
Dim WksIndex As Integer
Dim WksIndexZeile As Integer
Dim WksZielZeile As Integer
Application.ScreenUpdating = False
For WksIndex = 1 To Worksheets.Count
If WksIndex <> 3 Then
Worksheets(WksIndex).Activate
WksIndexZeile = Worksheets(WksIndex).UsedRange.SpecialCells(xlCellTypeLastCell).Row
WksZielZeile = Worksheets(3).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
ReDim ArrWks(WksIndexZeile, 3) As Variant
ArrWks() = Range("A2:C" & WksIndexZeile)
Worksheets(3).Range("A" & WksZielZeile & ":C" & WksZielZeile + WksIndexZeile - 2) = ArrWks()
End If
Next WksIndex
Worksheets(3).Columns("A:C").Sort Key1:=Worksheets(3).Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Application.ScreenUpdating = True
End Sub

Answer 3

hi all ^^

wie immer korrigiert *grummel*

gruss nighty

Option Explicit
Sub Sammeln()
Dim WksIndex As Integer
Dim WksIndexZeile As Long
Dim WksZielZeile As Long
Application.ScreenUpdating = False
For WksIndex = 1 To Worksheets.Count
If WksIndex <> 3 Then
Worksheets(WksIndex).Activate
WksIndexZeile = Worksheets(WksIndex).UsedRange.SpecialCells(xlCellTypeLastCell).Row
WksZielZeile = Worksheets(3).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
ReDim ArrWks(WksIndexZeile, 3) As Variant
ArrWks() = Range("A2:C" & WksIndexZeile)
Worksheets(3).Range("A" & WksZielZeile & ":C" & WksZielZeile + WksIndexZeile - 2) = ArrWks()
End If
Next WksIndex
Worksheets(3).Columns("A:C").Sort Key1:=Worksheets(3).Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Application.ScreenUpdating = True
End Sub

Answer 4

hi all ^^

wo ich nur meinen kopf manchmal hab *hihi*

das geht natuerlich auch einfacher

gruss nighty

Option Explicit
Sub Sammeln()
Dim WksIndex As Integer
Dim WksIndexZeile As Long
Dim WksZielZeile As Long
Application.ScreenUpdating = False
For WksIndex = 1 To Worksheets.Count
If WksIndex <> 3 Then
WksIndexZeile = Worksheets(WksIndex).UsedRange.SpecialCells(xlCellTypeLastCell).Row
WksZielZeile = Worksheets(3).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
Worksheets(WksIndex).Range("A2" & ":C" & WksIndexZeile).Copy Worksheets(3).Range("A" & WksZielZeile)
End If
Next WksIndex
Worksheets(3).Columns("A:C").Sort Key1:=Worksheets(3).Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Application.ScreenUpdating = True
End Sub

Answer 5

hi all ^^

meine einrueckung *huch*

gruss nighty

Option Explicit
Sub Sammeln()
Dim WksIndex As Integer
Dim WksIndexZeile As Long
Dim WksZielZeile As Long
Application.ScreenUpdating = False
For WksIndex = 1 To Worksheets.Count
If WksIndex <> 3 Then
WksIndexZeile = Worksheets(WksIndex).UsedRange.SpecialCells(xlCellTypeLastCell).Row
WksZielZeile = Worksheets(3).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
Worksheets(WksIndex).Range("A2" & ":C" & WksIndexZeile).Copy Worksheets(3).Range("A" & WksZielZeile)
End If
Next WksIndex
Worksheets(3).Columns("A:C").Sort Key1:=Worksheets(3).Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Application.ScreenUpdating = True
End Sub

Answer 6

hi all ^^

ich schaff es schon die datenbank zu befuellen *hehe*

gruss nighty