Makro: Neue Zeilen aus anderen Tabs sofort in ein Übersicht - Tabellenblatt kopieren

Question

Hallo,

leider keine Lösung bisher gefunden:

es gibt eine Excel (2003) Tabelle mit 5 Tabs: "B1", "B2" etc.), in welche 5 Personen Ihre Daten einftragen. Jeder Person ist sozusagen ein Tab zugewiesen. Die Überschriften sind in jedem Tabellenblatt gleich, so dass der jeweilige Bearbeiter die Namen der verkauften Produkte + Preis etc. in sein Tabellenblatt einträgt.

Schön wäre es, eine Übersicht der ersten 6 Zellen einer Zeile aus allen 5 Tabs in einem neuen Tabellenblatt zu haben. Damit man unabhängig vom Bearbeiter alle verkauften Artikel auf einen Blick hat.

Und zwar: sobald eine neue Zeile in irgendeinem anderen Tabellenblatt ausgefüllt wird, sollen die Infos auch ins "Übersicht"-Tabellenblatt kopiert werden.

Gibt's dafür eine Lösung mit VBA? Habe leider nur minimale Kenntnisse über Makros.

Vielen vielen Dank!!!

[*][sup]
*Threadedit* 23.01.2009, 23:33:01
Admininfo: Führ bitte Threads nicht fort indem du Weitere eröffnest, und vermeide Mehrfachanfragen. Die Datenbank und User werden es dir danken. Siehe FAQ 2, #3.[/sup]

Answer 1

hi all :-)

hier ein weiteres beispiel,mit einer erzwungenen eingabe sowie man die zellenbereiche a bis f befuellt

gruss nighty

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
If Target.Column < 7 And ActiveSheet.Name <> "Uebersicht" Then
Dim rgBereich As Range
Dim zaehler As Range
Set rgBereich = ActiveSheet.Range("A" & Target.Row & ",B" & Target.Row & ",C" & Target.Row _
& ",D" & Target.Row & ",E" & Target.Row & ",F" & Target.Row)
For Each zaehler In rgBereich
If zaehler = "" Then
schalter = True
zaehler.Select
Exit For
End If
Next zaehler
If schalter = False Then
ActiveSheet.Range("A" & Target.Row & ":F" & Target.Row).Copy Worksheets("Uebersicht").Range("A" & Worksheets("Uebersicht").Cells(Rows.Count, 1).End(xlUp).Row + 1)
Worksheets("Uebersicht").Range("G" & Worksheets("Uebersicht").Cells(Rows.Count, 1).End(xlUp).Row) = ActiveSheet.Name
End If
End If
Application.EnableEvents = True
End Sub

Answer 2

Hallo Sunshine.hh,

nachfolgend ein Beispiel, das zu Beginn die alte Übersicht löscht und dann aus den Tabellenblättern "B1" und "B2" eine neue Übersicht erstellt, die zum Schluß nach Datum sortiert wird. Für mehr als 2 Tabellenblätter muss der Code nur entsprechend kopiert und angepaßt werden.

Ich bin in meinem Beispiel davon ausgegangen, dass die Überschrift aus genau einer Zeile besteht und die Daten überall in Zeile 2 beginnen, sowie dass ein Datum vorhanden ist und dieses in der 1. Spalte steht.

Gruß sigiru

--------------------

Sub uebersicht_erstellen()

Dim Zeilen As Integer ' Anzahl der Zeilen im jeweiligen Blatt
Dim StartZ As Integer ' Start-Zeile im Übersichts-Blatt

' wenn alte Übersicht vorhanden, dann löschen

If Worksheets("Übersicht").Cells(Rows.Count, 1).End(xlUp).Row > 1 Then
Worksheets("Übersicht").Range("a2:f" & Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
End If

StartZ = 2

' B1 kopieren

Zeilen = Worksheets("B1").Cells(Rows.Count, 1).End(xlUp).Row - 1

Worksheets("B1").Range("A2:F" & Zeilen + 1).Copy _
Destination:=Worksheets("Übersicht").Range("A" & StartZ & ":F" & StartZ + Zeilen - 1)

StartZ = StartZ + Zeilen

' B2 kopieren

Zeilen = Worksheets("B2").Cells(Rows.Count, 1).End(xlUp).Row - 1

Worksheets("B2").Range("A2:F" & Zeilen + 1).Copy _
Destination:=Worksheets("Übersicht").Range("A" & StartZ & ":F" & StartZ + Zeilen - 1)

StartZ = StartZ + Zeilen

' sortieren

Worksheets("Übersicht").Range("A2:F" & Cells(Rows.Count, 1).End(xlUp).Row).Sort _
Key1:=Worksheets("Übersicht").Range("A2"), order1:=xlAscending, Header:=xlYes, Orientation:=xlTopToBottom

End Sub

Answer 3

hi all :-)

na wird ja auch mal zeit das ideen zum vorschein kommen :-))

@ sigiru
die beiden integer var sollten aber als long deklariert sein :-)

gruss nighty

Answer 4

Hi nighty,

ja, das ist richtig. Wenn die Bearbeiter ganz fleißig Zeilen eingeben, ist man mit long natürlich auf der sicheren Seite :-)

Gruß sigiru

Answer 5

Hallo nighty und sigiru,

danke für eure Vorschläge!! Beide erfüllen meine Wünsche :)
Ich tendiere jedoch zu der löschen/kopieren Version (sigiru), da gehen dann keine Daten verloren.

Was mir aber noch fehlt, ist die Automatisierung, d.h. das Makro immer beim Speichern der Tabelle zu aktivieren.

Würde mich auf die Antwort freuen!

Answer 6

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dein Makro
oder Call Makronamme

End Sub