Daten auf einzelne Registerblätter sortieren

easyrider0000 · 17. März 2011 um 14:14

Hallo" (und einen besonderen Gruss an Reinhard )
Excel 2010
Ich habe folgende Konstellation:

Auf diesem Registerblatt werden neue Daten der Reihe nach eingetragen.

Desweiteren soll beim Hinzufügen von Daten auf Registerblatt 1 die Ansichten auf den entsprechenden Registerkarten aktualisiert werden, da sich die Gebietsnummer der einzelnen Sätze ggf. ändern können.

OKOK.
Ich könnte das zwar über die Filterfunktion in der jeweiligen Spalte machen, aber da müsste ich beim Drucken immer wieder den Filter ändern.

Liebe Gruesse
ER

Thomas_Ramel · 17. März 2011 um 14:36

Grüezi easyrider

Registerblatt 1:
Spalte A|Spalte B|Spalte C|Spalte D|Spalte E|Spalte F
Ordn.Nr.|Vorname.|Nachname|Email…|Aktiv…|Gebiet

Auf diesem Registerblatt werden neue Daten der Reihe nach
eingetragen.

Vorbildliche Datenstruktur!

Nun will ich für jedes Gebiet (Spalte F) eine eigene
Registerkarte anlegen, auf der nur die für das jeweilige
Gebiet passenden Datensätze (Spalte A-E) angezeigt werden.
Beispiel:
Registerblatt 2:
Spalte A|Spalte B|Spalte C|Spalte D|Spalte E|Spalte F
123…|Andi…|Müller…|Mailaddi|Aktiv…|…1…
234…|Frank…|Schmidt.|Mailaddi|Inaktiv.|…1…

Registerblatt 3:
Spalte A|Spalte B|Spalte C|Spalte D|Spalte E|Spalte F
345…|Bernd…|Maier…|Mailaddi|Aktiv…|…2…
3455…|Herbert.|Schulze.|Mailaddi|Aktiv…|…2…

Nimm Spalte F bitte auch noch hinzu, dann kannst Du die folgende Muster-Datei 1:1 verwenden.

http://users.quick-line.ch/ramel/Files/spezialfilter…

Füge ins erste Tabellenblatt deine Daten ein wie es in den Hinweisen in der Mappe beschrieben wird.

Lösche dann alle Blätter bis auf die ersten beiden.

Füge im Blatt 2 in Zeile 1 deine Spaltenüberschriften aus Blatt 1 1:1 ein, leere den Inhalt der Zeile 2 und gib in Spalte F den Namen eines Gebites an.

Kopiere dann Blatt 2 so oft wie benötigt und passe jeweils den Namen des Gebites an.

Desweiteren soll beim Hinzufügen von Daten auf Registerblatt 1
die Ansichten auf den entsprechenden Registerkarten
aktualisiert werden, da sich die Gebietsnummer der einzelnen
Sätze ggf. ändern können.

Ja, das tut es dann natürlich auch.

Mit freundlichen Grüssen

Thomas Ramel

MVP für MS-Excel -

easyrider0000 · 17. März 2011 um 23:54

Hi.
Danke@Thomas
Funktioniert perfekt.
LG

Reinhard_fb8cb7 · 18. März 2011 um 11:52

Registerblatt 1:
Spalte A|Spalte B|Spalte C|Spalte D|Spalte E|Spalte F
Ordn.Nr.|Vorname.|Nachname|Email…|Aktiv…|Gebiet

Auf diesem Registerblatt werden neue Daten der Reihe nach
eingetragen.

Nun will ich für jedes Gebiet (Spalte F) eine eigene
Registerkarte anlegen, auf der nur die für das jeweilige
Gebiet passenden Datensätze (Spalte A-E) angezeigt werden.

Hallo Ryder,

du brauchst ein Blatt „Tabelle1“, ggfs. im Code an zwei Stellen anpassen wenn es anders heißt.
In F2 ff werden die Gebietswerte erwartet, dreistellige Nummern, ggfs. anpassen.

Option Explicit

Sub Filtern()
Dim Zei As Long, colC As New Collection, C As Long, wksH As Worksheet
Call Schnell(True)
Call Einmalig
Set wksH = Worksheets("Hilf")
With Worksheets("Tabelle1") 'ggfs. anpassen
 Zei = .Cells(Rows.Count, 1).End(xlUp).Row
 On Error Resume Next 'wg. colc
 For C = 2 To Zei '6-te Spalte = F, ggfs.anpassen
 colC.Add key:=CStr(.Cells(C, 6).Value), Item:=CStr(.Cells(C, 6).Value)
 Next C
 On Error GoTo hell
 Application.DisplayAlerts = False
 For C = ThisWorkbook.Worksheets.Count To 1 Step -1
 If ThisWorkbook.Worksheets(C).Name Like "Geb\*" Then
 ThisWorkbook.Worksheets(C).Delete
 End If
 Next C
 Application.DisplayAlerts = True
 For C = 1 To colC.Count
 Worksheets.Add.Name = "Geb." & Right("000" & colC(C), 3)
 Next C
 For C = 1 To colC.Count
 wksH.Range("A2:F1000").ClearContents
 wksH.Range("F2") = colC(C)
 .Range("A1:F" & Zei).AdvancedFilter Action:=xlFilterCopy, \_
 CriteriaRange:=wksH.Range("A1:F2"), \_
 CopyToRange:=Worksheets("Geb." & Right("000" & colC(C), 3)).Range("A1")
 Next C
 .Move Before:=Sheets(1)
End With
hell:
If Err.Number Then MsgBox Err.Number & vbCrLf & Err.Description
Call Schnell(False)
End Sub

Sub Schnell(ByVal bolWert As Boolean)
Application.ScreenUpdating = bolWert
Application.Calculation = IIf(bolWert = True, xlAutomatic, xlManual)
Application.EnableEvents = bolWert
End Sub

Sub Einmalig()
On Error Resume Next
 Application.DisplayAlerts = False
 ThisWorkbook.Worksheets("Hilf").Visible = True
 ThisWorkbook.Worksheets("Hilf").Delete
 Application.DisplayAlerts = True
On Error GoTo 0
Worksheets.Add.Name = "Hilf"
' Tabelle1 ggfs. anpassen
Worksheets("Tabelle1").Rows(1).Copy Destination:=Worksheets("Hilf").Range("A1")
Worksheets("Hilf").Visible = xlVeryHidden
End Sub

Gruß
Reinhard