Live-Forum - Die aktuellen Beiträge
Datum
Titel
18.04.2024 12:28:32
Formelfehler aufgrund Einfügen einer Zeile
18.04.2024 11:51:04
Aus Listbox Spalte als Wert zurück bekommen
18.04.2024 11:36:51
Beim Öffnen je nach Datum zu bestimmter Zelle springen
18.04.2024 11:16:38
Pfade werden mit Anführungszeichen "" versehen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1096to1100
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
1096to1100
1096to1100
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Tabelle aufteilen!

Tabelle aufteilen!
Nico
Hallo Ihr,
und schon einmal vorab vielen Dank.
Ich habe eine Datei mit Datensätzen (macht ja sonst auch keinen Sinn) Diese Datensätze werden von Personen betreut, die ich zur Aktualisierung auffordern möchte.
Die Personen stehen in Spalte E ab Zeile 13. Nun suche ich nach einem Makro, welches folgendes kann, nach dem ich die ganzen Datensätze nach den Personen, die ich anschreiben möchte sortiert habe.
Das Makro soll je Person ein Tabellenblatt anlegen und das Tabellenblatt "Datenbank" quasi aufteilen. Das Tabellenblatt kann im Idealfall den Namen der Person tragen.
Also wie gesagt - vorab schon vielen vielen Dank, allein darüb nachzudenken.
Beste Grüße
Nico

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

Betreff
Benutzer
Anzeige
AW: Tabelle aufteilen!
01.09.2009 11:02:12
Oberschlumpf
Hi Nico
Schön wäre (d)eine Bsp-Datei mit Bsp-Daten mit Erklärung, welche Daten genau wann wo wie erscheinen sollen.
Ciao
Thorsten
AW: Tabelle aufteilen!
01.09.2009 12:29:45
Nico
Hallo Thorsten,
du hast natürlich absolut Recht!

Die Datei https://www.herber.de/bbs/user/64153.xls wurde aus Datenschutzgründen gelöscht


Das Makro sollte in den daruffolgenden Tabellenblättern die Firmen der Person1, Person2, Person3 aufteilen. Alle Daten sollen übernommen werden.
Beste Grüße und Danke vorab für Deine Mühe.
Nico
AW: Tabelle aufteilen!
01.09.2009 14:58:54
hary
Hallo Nico
teste mal durch. Code evtl nicht schoen, aber er tut's.
https://www.herber.de/bbs/user/64158.xls
Gruss hary
Anzeige
AW: Tabelle aufteilen!
07.09.2009 14:28:27
Nico
Hallo Hary,
wenn ich jetzt das Makro auf meinen Datensatz anwende, dann werden nicht alle Daten auf die Tabellenblätter aufgeteilt. Das Makro stoppt also zu früh mit der Selektion! Mein letzter Datensatz befindet sich in Zeile 1990. Kannst mir bitte verraten welche Dinge ich im Makro anpassen muss? Oder kannst Du es bitte entsprechend anpassen?
Vielen vielen Dank vorab
beste grüße Nico
AW: Tabelle aufteilen!
07.09.2009 15:51:24
hary
Hallo Nico
Habe diesen Code geteste erstemal bis 2900 und laeuft durch. kann es sein das in Spalte A der letzte Eintrag nicht in zeile 1990 ist sondern davor, wo er stoppt? In den Code holt er die letzte besetzte Zelle aus Spalte A. Wenn zum Beispiel die letzte beschrieben Zelle A1550 ist und Deine Daten in Spalte F bis 1990 gehen macht er es trotzdem nur bis 1550. Dann muesste die Spalten Nr. in Cells(Rows.Count, 1)(die 1 steht fuer SpalteA) in die Spalte geaendert werden die wirklick den letzten Eintrag hat.

Sub verteilen()
Dim sh As Worksheet, strName As String
Dim i As Long
Dim Text As String
Application.ScreenUpdating = False
For i = Cells(Rows.Count, 1).End(xlUp).Row To 13 Step -1
strName = Cells(i, 6)
On Error Resume Next
Set sh = Sheets(strName)
If sh Is Nothing Then
Text = Cells(i, 6)
Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = Text
Worksheets("Tabelle1").Activate
End If
Next
For Each sh In Sheets
For i = Worksheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row To 13 Step -1
If sh.Name = Cells(i, 6) Then
Worksheets("Tabelle1").Cells(i, 6).EntireRow.Copy sh.Cells(sh.Cells(Rows.Count, 1).End(xlUp). _
Row + 1, 1)
End If
Next
Next
Application.ScreenUpdating = True
End Sub

Gruss hary
Anzeige
AW: etwas schneller
07.09.2009 16:03:17
hary
hallo Nico
so geht der code etwas schneller 

Sub verteilen()
Dim sh As Worksheet, strName As String
Dim i As Long
Dim Text As String
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For i = Cells(Rows.Count, 1).End(xlUp).Row To 13 Step -1
strName = Cells(i, 6)
On Error Resume Next
Set sh = Sheets(strName)
If sh Is Nothing Then
Text = Cells(i, 6)
Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = Text
Worksheets("Tabelle1").Activate
End If
Next
For Each sh In Sheets
For i = Worksheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row To 13 Step -1
If sh.Name = Cells(i, 6) Then
Worksheets("Tabelle1").Cells(i, 6).EntireRow.Copy sh.Cells(sh.Cells(Rows.Count, 1).End(xlUp). _
Row + 1, 1)
End If
Next
Next
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub

Gruss hary
Anzeige

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige