Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 06:38:45
Kumulierte Daten für Intervalllaufeinheiten
24.04.2024 04:37:43
Mit Word erstellte PDF als Anhang an E-Mail anhängen
24.04.2024 00:20:14
Bestimmte Spalten als xls exportieren per Makro
23.04.2024 22:08:10
Auflisten in Spalte VBA
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
992to996
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
992to996
992to996
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Tabellenblatt aufteilen auf x Blätter

Tabellenblatt aufteilen auf x Blätter
12.07.2008 15:23:40
Jean
Hallo,
im Tabellenblatt Kunden sind sehr viele Kunden aufgelistet mit KuNr, Zuname etc. und mit dem jeweiligen Berater des Kunden.
Wie kann man die Tabelle so aufteilen, dass pro Berater (ca. 80) dessen Kunden mit allen Daten in einem separaten Tabellenblatt angelegt werden?
Dank im Voraus.
Gruß
Jean

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Tabellenblatt aufteilen auf x Blätter
12.07.2008 15:53:52
Daniel
Hi
du könntest dieses Makro verwenden:

Sub Aufteilen()
Dim Zelle1 As Range
Dim Zelle2 As Range
With Sheets("Kunden")
Set Zelle2 = .Range("B1") 'Berater stehen in Spalte B
.Range("A1").CurrentRegion.Sort key1:=Zelle2, order1:=xlAscending, header:=xlYes
Do
Set Zelle1 = Zelle2.Offset(1, 0)
If Zelle1.Value = "" Then Exit Do
Set Zelle2 = Zelle2.EntireColumn.Find(what:=Zelle1.Value, _
after:=.Cells(Rows.Count, Zelle2.Column), _
lookat:=xlWhole, searchdirection:=xlPrevious)
Sheets.Add after:=Sheets(ThisWorkbook.Sheets.Count)
ActiveSheet.Name = Zelle1.Value
.Rows(1).Copy Destination:=Cells(1, 1)
.Range(Zelle1, Zelle2).EntireRow.Copy Destination:=Cells(Rows.Count, 1).End(xlUp). _
Offset(1, 0)
Loop
End With
End Sub


sollte das Makro ein zweites mal laufen, musst du vorher die Beraterblätter wieder löschen.
Gruß, Daniel
hier die Datei dazu:
https://www.herber.de/bbs/user/53770.xls

Anzeige
AW: Tabellenblatt aufteilen auf x Blätter
12.07.2008 20:37:58
Jean
Hallo Daniel,
vielen Dank für Dein Programm.
Die Mappe hat im Moment nur das Tabellenblatt Kunden mit im Moment 7 echten Datensätzen.
In der Zeile 1 stehen als Überschriften in A1 kunden in B1 Berater.
Startet man das Programm, so werden zunächst die Datensätze nach den Beratern sortiert, dann
Tabellenblätter für die 3 Berater angelegt, die Datensätze aber an die Sätze in der Kundentabelle angehängt und dann erscheint die Fehlermeldung Laufzeitfehler 1004.
Irgend etwas mache ich wohl falsch. Kannst Du mir auf die Sprünge helfen?
Gruß
Jean

AW: Tabellenblatt aufteilen auf x Blätter
12.07.2008 21:00:00
Daniel
Hi
solange ich nicht weiß, was du genau machst, leider nein.
in meiner Beispieldatei funktioniert es ja.
du solltest schon deine Datei hochladen.
Gruß, Daniel

Anzeige
AW: Tabellenblatt aufteilen auf x Blätter
12.07.2008 21:44:00
Jean
Hallo Daniel,
mal sehen ob der Upload funktioniert.
Vielen Dank für Deine weitere Hilfe.
Gruß
Jean
https://www.herber.de/bbs/user/53772.xls

AW: Tabellenblatt aufteilen auf x Blätter
12.07.2008 21:51:00
Daniel
HI
der Code steht im falschen Modul (hätte dir aber auffallen müssen, wenn du dir meine Datei anschaust)
er muss in ein allgemeines Modul und nicht ins Modul der Tabelle.
andernfalls musst du den Code etwas abändern und in allen Zellbezügen, bei denen kein Sheet referenziert ist, "ActiveSheet." davorsetzten:

.Rows(1).Copy Destination:=ActiveSheet.Cells(1, 1)
.Range(Zelle1, Zelle2).EntireRow.Copy Destination:=ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)


Gruß, Daniel

Anzeige
AW: Tabellenblatt aufteilen auf x Blätter
12.07.2008 21:52:22
Jean
Hallo Daniel,
ich habe meinen Fehler gefunden.
Das Programm läuft astrein.
Entschuldige bitte meinen letzten Beitrag.
Tausend Dank.
Einen schönen Abend.
Gruß
Jean

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige