Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
668to672
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
668to672
668to672
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Worksheets sortieren!

Worksheets sortieren!
19.09.2005 19:03:36
wuntschi
Hallo an alle,
ich möchte gerne 4 Datenblätter sortieren,
die Namen der Datenblätter sind:
Coordinates
GND-Principle
Layout1
Layout2
und zwar in der Reihenfolge (von links nach rechts in den Reitern!
1. Coordinates
2. Layout1
3. Layout2
4. GND-Principle.
Wichtig ist nosch das es durch aus sein kann das ein Tabellenblatt nicht vorhanden ist und somit das nächste auf rückt.
z.B. wenn Layout1 nicht da ist dann würde die Reihenfolge wie folgt heißen
1. Coordinates
2. Layout2
3. GND-Principle.
gruß
wuntschi

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Worksheets sortieren!
19.09.2005 19:12:22
Matthias
Hallo Wuntschi,

Sub Sortieren()
Dim ok As Integer
ok = 1
On Error Resume Next
Sheets("Coordinates").Move before:=Sheets(ok)
If Err.Number = 0 Then Err.Clear: ok = ok + 1
Sheets("Layout1").Move before:=Sheets(ok)
If Err.Number = 0 Then Err.Clear: ok = ok + 1
Sheets("Layout2").Move before:=Sheets(ok)
If Err.Number = 0 Then Err.Clear: ok = ok + 1
Sheets("GND-Principle").Move before:=Sheets(ok)
If Err.Number = 0 Then Err.Clear: ok = ok + 1
End Sub

Gruß Matthias
AW: Worksheets sortieren!
19.09.2005 19:26:27
wuntschi
Hallo Matthias,
ich habe den Code so erweitert

Sub Sortieren()
Dim ok As Integer
ok = 1
On Error Resume Next
Sheets("Coordinates").Move before:=Sheets(ok)
If Err.Number = 0 Then Err.Clear: ok = ok + 1
Sheets("Layout1").Move before:=Sheets(ok)
If Err.Number = 0 Then Err.Clear: ok = ok + 1
Sheets("Layout2").Move before:=Sheets(ok)
If Err.Number = 0 Then Err.Clear: ok = ok + 1
Sheets("GND_Principle1").Move before:=Sheets(ok)
If Err.Number = 0 Then Err.Clear: ok = ok + 1
Sheets("GND_Principle2").Move before:=Sheets(ok)
If Err.Number = 0 Then Err.Clear: ok = ok + 1
Sheets("SectorPositions").Move before:=Sheets(ok)
If Err.Number = 0 Then Err.Clear: ok = ok + 1
Sheets(" 8212 019 2961 1").Move before:=Sheets(ok)
If Err.Number = 0 Then Err.Clear: ok = ok + 1
Sheets("8212 019 2967 1").Move before:=Sheets(ok)
If Err.Number = 0 Then Err.Clear: ok = ok + 1
Sheets("8212 019 2968 1").Move before:=Sheets(ok)
If Err.Number = 0 Then Err.Clear: ok = ok + 1
If Err.Number = 0 Then Err.Clear: ok = ok + 1
Sheets("Optionen").Move before:=Sheets(ok)
If Err.Number = 0 Then Err.Clear: ok = ok + 1
Sheets("Sprache").Move before:=Sheets(ok)
If Err.Number = 0 Then Err.Clear: ok = ok + 1
Sheets("TesterPCB").Move before:=Sheets(ok)
If Err.Number = 0 Then Err.Clear: ok = ok + 1
End Sub

leider setzt er das Tabelleblatt "Coordinates" ans ende alle anderen sortiert er richtig!
wie kommt das?
gruß
wuntschi
Anzeige
AW: Worksheets sortieren!
19.09.2005 19:29:43
Matthias
Hallo Wuntschi,
die Zeile

If Err.Number = 0 Then Err.Clear: ok = ok + 1

kommt bei Dir im Code zweimal direkt hintereinander. Vielleicht liegt es daran.
Gruß Matthias
AW: Worksheets sortieren!
19.09.2005 19:31:48
wuntschi
Hallo,
das ist es nicht!
gruß
wuntschi
AW: Worksheets sortieren!
19.09.2005 19:34:40
Matthias
Hallo Wuntschi:
meine letzte Idee: die Tabellenblattnamen stimmen nicht 100%ig (Leerzeichen am Ende o.ä.).
Gruß Matthias
AW: Worksheets sortieren!
19.09.2005 19:36:44
wuntschi
Hallo,
das ist es leider auch nicht das habe ich gleich am anfang
kontrolliert!
gruß
wuntschi
AW: Worksheets sortieren!
19.09.2005 19:36:46
wuntschi
Hallo,
das ist es leider auch nicht das habe ich gleich am anfang
kontrolliert!
gruß
wuntschi
Anzeige
AW: Worksheets sortieren!
19.09.2005 19:53:36
Aton
Hi
Denke liegt am Blattnamen.
Ziehe es in die mitte der Blätter und tip das makro mit F8 makrofenster dabei auf Normalgröße durch.
dann kannst es Probieren woran es liegt.
Gruß
Aton
AW: Worksheets sortieren!
19.09.2005 21:54:00
wuntschi
Hallo Mattias und Anton,
ich habe nochmal drüber nachgedacht und da es immer das Blatt Coordinates und Layout1 gibt, habe ich folgendes gemacht!

Sub Sortieren()
Dim ok As Integer
ok = 1
On Error Resume Next
Sheets("Coordinates").Move before:=Sheets(ok)
If Err.Number = 0 Then Err.Clear: ok = ok + 1
Sheets("Layout1").Move before:=Sheets(ok)
If Err.Number = 0 Then Err.Clear: ok = ok + 1
Sheets("Layout2").Move before:=Sheets(ok)
If Err.Number = 0 Then Err.Clear: ok = ok + 1
Sheets("GND_Principle1").Move before:=Sheets(ok)
If Err.Number = 0 Then Err.Clear: ok = ok + 1
Sheets("GND_Principle2").Move before:=Sheets(ok)
If Err.Number = 0 Then Err.Clear: ok = ok + 1
Sheets("SectorPositions").Move before:=Sheets(ok)
If Err.Number = 0 Then Err.Clear: ok = ok + 1
Sheets(" 8212 019 2961 1").Move before:=Sheets(ok)
If Err.Number = 0 Then Err.Clear: ok = ok + 1
Sheets("8212 019 2967 1").Move before:=Sheets(ok)
If Err.Number = 0 Then Err.Clear: ok = ok + 1
Sheets("8212 019 2968 1").Move before:=Sheets(ok)
If Err.Number = 0 Then Err.Clear: ok = ok + 1
Sheets("Optionen").Move before:=Sheets(ok)
If Err.Number = 0 Then Err.Clear: ok = ok + 1
Sheets("Sprache").Move before:=Sheets(ok)
If Err.Number = 0 Then Err.Clear: ok = ok + 1
Sheets("TesterPCB").Move before:=Sheets(ok)
If Err.Number = 0 Then Err.Clear: ok = ok + 1
Sheets("Coordinates").Move before:=Sheets("Layout1")
End Sub

ist vieleicht nicht die sauberste art aber funtzt!
gruß
wuntschi
Anzeige
AW: Worksheets sortieren!
19.09.2005 23:18:30
Aton
Hi
Sortiert er an einer anderen position das Blatt richtig ein.
JA-Nein
Gruß Aton
PS. Hast schon mit umbenenen des Blattes versucht, und was ist dann passiert.
AW: Worksheets sortieren!
21.09.2005 00:39:44
wuntsch
Hallo,
ich kann die Namen der Worksheets nicht ändern da diese weiter verwendet werden,
und das zuviele Änderungen zur folge hätte.
Meine Lösung die zwar nicht besonders schön ist ber funtzt ist
wie folgt:

Sub sortieren_2()
Dim wrsAlleWorksheets As Worksheet
Dim blnCoordinates As Boolean
Dim blnLayout1 As Boolean
Dim blnLayout2 As Boolean
Dim blnGND1 As Boolean
Dim blnGND2 As Boolean
Dim blnSecPosition As Boolean
Dim bln2961 As Boolean
Dim bln2967 As Boolean
Dim bln2968 As Boolean
For Each wrsAlleWorksheets In Worksheets
Select Case wrsAlleWorksheets.Name
Case Is = "Coordinates"
blnCoordinates = True
Case Is = "Layout1"
blnLayout1 = True
Case Is = "Layout2"
blnLayout2 = True
Case Is = "GND_Principle1"
blnGND1 = True
Case Is = "GND_Principle2"
blnGND2 = True
Case Is = "SectorPositions"
blnSecPosition = True
Case Is = " 8212 019 2961 1"
bln2961 = True
Case Is = "8212 019 2967 1"
bln2967 = True
Case Is = "8212 019 2968 1"
bln2968 = True
End Select
Next wrsAlleWorksheets
If blnCoordinates = True And blnLayout1 Then
Sheets("Coordinates").Move before:=Sheets("Layout1")
If Err.Number = 0 Then Err.Clear
Else
If blnCoordinates = True And blnLayout2 Then
Sheets("Coordinates").Move before:=Sheets("Layout2")
If Err.Number = 0 Then Err.Clear
Else
If blnCoordinates = True And blnGND1 Then
Sheets("Coordinates").Move before:=Sheets("GND_Principle1")
If Err.Number = 0 Then Err.Clear
Else
If blnCoordinates = True And blnGND2 Then
Sheets("Coordinates").Move before:=Sheets("GND_Principle2")
If Err.Number = 0 Then Err.Clear
Else
If blnCoordinates = True And blnSecPosition Then
Sheets("Coordinates").Move before:=Sheets("SectorPositions")
If Err.Number = 0 Then Err.Clear
Else
If blnCoordinates = True And bln2961 Then
Sheets("Coordinates").Move before:=Sheets(" 8212 019 2961 1")
If Err.Number = 0 Then Err.Clear
Else
If blnCoordinates = True And bln2967 Then
Sheets("Coordinates").Move before:=Sheets("8212 019 2967 1")
If Err.Number = 0 Then Err.Clear
Else
If blnCoordinates = True And bln2968 Then
Sheets("Coordinates").Move before:=Sheets("8212 019 2968 1")
If Err.Number = 0 Then Err.Clear
End If
End If
End If
End If
End If
End If
End If
End If
If blnLayout1 = True And blnLayout2 Then
Sheets("Layout1").Move before:=Sheets("Layout2")
If Err.Number = 0 Then Err.Clear
Else
If blnLayout1 = True And blnGND1 Then
Sheets("Layout1").Move before:=Sheets("GND_Principle1")
If Err.Number = 0 Then Err.Clear
Else
If blnLayout1 = True And blnGND2 Then
Sheets("Layout1").Move before:=Sheets("GND_Principle2")
If Err.Number = 0 Then Err.Clear
Else
If blnLayout1 = True And blnSecPosition Then
Sheets("Layout1").Move before:=Sheets("SectorPositions")
If Err.Number = 0 Then Err.Clear
Else
If blnLayout1 = True And bln2961 Then
Sheets("Layout1").Move before:=Sheets(" 8212 019 2961 1")
If Err.Number = 0 Then Err.Clear
Else
If blnLayout1 = True And bln2967 Then
Sheets("Layout1").Move before:=Sheets("8212 019 2967 1")
If Err.Number = 0 Then Err.Clear
Else
If blnLayout1 = True And bln2968 Then
Sheets("Layout1").Move before:=Sheets("8212 019 2968 1")
If Err.Number = 0 Then Err.Clear
End If
End If
End If
End If
End If
End If
End If
If blnLayout2 = True And blnGND1 Then
Sheets("Layout2").Move before:=Sheets("GND_Principle1")
If Err.Number = 0 Then Err.Clear
Else
If blnLayout2 = True And blnGND2 Then
Sheets("Layout2").Move before:=Sheets("GND_Principle2")
If Err.Number = 0 Then Err.Clear
Else
If blnLayout2 = True And blnSecPosition Then
Sheets("Layout2").Move before:=Sheets("SectorPositions")
If Err.Number = 0 Then Err.Clear
Else
If blnLayout2 = True And bln2961 Then
Sheets("Layout2").Move before:=Sheets(" 8212 019 2961 1")
If Err.Number = 0 Then Err.Clear
Else
If blnLayout2 = True And bln2967 Then
Sheets("Layout2").Move before:=Sheets("8212 019 2967 1")
If Err.Number = 0 Then Err.Clear
Else
If blnLayout2 = True And bln2968 Then
Sheets("Layout2").Move before:=Sheets("8212 019 2968 1")
If Err.Number = 0 Then Err.Clear
End If
End If
End If
End If
End If
End If
If blnGND1 = True And blnGND2 Then
Sheets("GND_Principle1").Move before:=Sheets("GND_Principle2")
If Err.Number = 0 Then Err.Clear
Else
If blnGND1 = True And blnSecPosition Then
Sheets("GND_Principle1").Move before:=Sheets("SectorPositions")
If Err.Number = 0 Then Err.Clear
Else
If blnGND1 = True And bln2961 Then
Sheets("GND_Principle1").Move before:=Sheets(" 8212 019 2961 1")
If Err.Number = 0 Then Err.Clear
Else
If blnGND1 = True And bln2967 Then
Sheets("GND_Principle1").Move before:=Sheets("8212 019 2967 1")
If Err.Number = 0 Then Err.Clear
Else
If blnGND1 = True And bln2968 Then
Sheets("GND_Principle1").Move before:=Sheets("8212 019 2968 1")
If Err.Number = 0 Then Err.Clear
End If
End If
End If
End If
End If
If blnGND2 = True And blnSecPosition Then
Sheets("GND_Principle2").Move before:=Sheets("SectorPositions")
If Err.Number = 0 Then Err.Clear
Else
If blnGND2 = True And bln2961 Then
Sheets("GND_Principle2").Move before:=Sheets(" 8212 019 2961 1")
If Err.Number = 0 Then Err.Clear
Else
If blnGND2 = True And bln2967 Then
Sheets("GND_Principle2").Move before:=Sheets("8212 019 2967 1")
If Err.Number = 0 Then Err.Clear
Else
If blnGND2 = True And bln2968 Then
Sheets("GND_Principle2").Move before:=Sheets("8212 019 2968 1")
If Err.Number = 0 Then Err.Clear
End If
End If
End If
End If
If blnSecPosition = True And bln2961 Then
Sheets("SectorPositions").Move before:=Sheets(" 8212 019 2961 1")
If Err.Number = 0 Then Err.Clear
Else
If blnSecPosition = True And bln2967 Then
Sheets("SectorPositions").Move before:=Sheets("8212 019 2967 1")
If Err.Number = 0 Then Err.Clear
Else
If blnSecPosition = True And bln2968 Then
Sheets("SectorPositions").Move before:=Sheets("8212 019 2968 1")
If Err.Number = 0 Then Err.Clear
End If
End If
End If
If bln2961 = True And bln2967 Then
Sheets(" 8212 019 2961 1").Move before:=Sheets("8212 019 2967 1")
If Err.Number = 0 Then Err.Clear
Else
If bln2961 = True And bln2968 Then
Sheets(" 8212 019 2961 1").Move before:=Sheets("8212 019 2968 1")
If Err.Number = 0 Then Err.Clear
End If
End If
If bln2961 = True And bln2968 Then
Sheets(" 8212 019 2961 1").Move before:=Sheets("8212 019 2968 1")
If Err.Number = 0 Then Err.Clear
End If
Worksheets("Coordinates").Select
End Sub

gruß
wuntschi
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige