Datenaufteilung in verschiedene Arbeitsblätter

Forumthread: Datenaufteilung in verschiedene Arbeitsblätter

13.10.2004 12:45:58

Helmut

Hallo Community,
wer kann mir bei folgenden Problem helfen.
Ich möchte ein Arbeitsblatt in verschiedene Arbeitsblätter aufteilen.
Habe ca. 800 Postleitzahlen. Die könnte ich natürlich immer alle kopieren und in ein neues Arbeitsblatt kopieren.
Das Szenario habe ich allerdings einmal die Woche und da wird es dann schon lästig ;(
Habe ein Beispiel angehängt.
https://www.herber.de/bbs/user/12042.xls
BITTE HELFT MIR!!!!
thx
Helmut

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Datenaufteilung in verschiedene Arbeitsblätter

Beni

Hallo Helmut,
dieser Code fügt die Daten an die bestehenden Daten an, wenn Tabelle nicht vorhanden, wird sie erstellt.
Gruss Beni


Sub Datenaufteilung_in_verschiedene_Arbeitsblätter()
For Plz = 2 To Cells(Rows.Count, 8).End(xlUp).Row
Ort = Cells(Plz, 8) & " " & Cells(Plz, 9)
On Error Resume Next
Set ws = Sheets(Ort)
If Err > 0 Or ws Is Nothing Then
Sheets("Test").Copy After:=Sheets(Sheets.Count)
neuws = Sheets.Count
Sheets(neuws).Name = Ort
lz = Sheets(Ort).Cells(Rows.Count, 8).End(xlUp).Row
Range(Cells(lz, 1), Cells(lz, 29)).Delete Shift:=xlUp
End If
On Error GoTo 0
lz = Sheets(Ort).Cells(Rows.Count, 8).End(xlUp).Row
Range(Cells(Plz, 1), Cells(Plz, 29)).Copy Sheets(Ort).Cells(lz + 1, 1)
Sheets(Ort).PageSetup.PrintArea = "$A$1:$AB$" & lz + 1
Next Plz
End Sub

AW: Datenaufteilung in verschiedene Arbeitsblätter

Helmut

Hallo Beni,
funktioniert zum Teil super - hat nur den Fehler, dass in den nächsten Tabellenblättern nur die Daten stehen sollten, die die gleiche PLZ haben.
Weist du dafür auch noch ein Formel.
Ich bin leider damit überfordert.
Trotzdem hilft mir das auch schon etwas weiter.
lg
Helmut

AW: Datenaufteilung in verschiedene Arbeitsblätter

Beni

Hallo Helmut,
ich habe den Fehler korrigiert.
Gruss Beni


Sub Datenaufteilung_in_verschiedene_Arbeitsblätter()
Sheets("Test").Select
For Plz = 2 To Cells(Rows.Count, 8).End(xlUp).Row
Ort = Cells(Plz, 8) & " " & Cells(Plz, 9)
On Error Resume Next
Set ws = Sheets(Ort)
If Err > 0 Or ws Is Nothing Then
Sheets("Test").Copy After:=Sheets(Sheets.Count)
neuws = Sheets.Count
Sheets(neuws).Name = Ort
With Sheets(Ort)
lz = Cells(Rows.Count, 8).End(xlUp).Row
Range(Cells(2, 1), Cells(lz, 29)).Delete Shift:=xlUp
Sheets("Test").Select
End With
End If
On Error GoTo 0
lz = Sheets(Ort).Cells(Rows.Count, 8).End(xlUp).Row
Range(Cells(Plz, 1), Cells(Plz, 29)).Copy Sheets(Ort).Cells(lz + 1, 1)
Sheets(Ort).PageSetup.PrintArea = "$A$1:$AB$" & lz + 1
Next Plz
End Sub

AW: Datenaufteilung in verschiedene Arbeitsblätter

13.10.2004 16:36:01

Helmut

Hallo Beni,
perfekt überhaupt kein Fehler mehr - auch wenn das jetzt ein wenig nach Blasphemie klingt - du bist ein Gott für mich ;)
Vielen lieben Dank.
PS: Kann ich da jetzt auch 10.000 Daten drüberlassen?

Beliebteste Forumthreads (12 Monate)

Datenaufteilung in verschiedene Arbeitsblätter

Forumthread: Datenaufteilung in verschiedene Arbeitsblätter

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread