Tabellen... an das Ende der Liste sortieren
26.01.2009 12:18:54
Alex
mit diesem zusammengeschusterten Code
bewirke ich, das Tabellenblätter (je nach Eintragung in Zelle A4 eines jeden) umbenannt werden.
Nächster Part ist die auflistung in einem Frontblatt "Übersicht".
Dort werden die eben aufgelisteten Namen alphab. sortiert.
Dann richtet sich die Anordnung der Tabellenblätter nach dieser sortierten Auflistung.
Löscht man einen Namen aus A4, bekommt Tabellenblatt wieder seinen Ursprungsnamen.
Ab 'alphab. Sortierung Frontblatt ab A5 - 200 hab ich dann das Problem, dass alle leeren Tabellenblätter unter "T" einsortiert werden.
Wie könnte man schreiben, dass alle Blätter die "Tabelle..." heißen an das untere Ende sortiert werden?
hier der gesamte Code:
Sub t()
'Blattname aus Zelle des Blattes
Dim Blatt As Object 'Blattname aus Zelle des Blattes
Dim i As Long, j As Long 'Auflistung aller Tabellen so wie ihre momentane Reihenfolge _
ist
Dim x As String 'Auflistung aller Tabellen so wie ihre momentane Reihenfolge _
ist
Dim all As Long 'Auflistung aller Tabellen so wie ihre momentane Reihenfolge _
ist
Dim shArray() 'Auflistung aller Tabellen so wie ihre momentane Reihenfolge _
ist
Dim Zelle As Range 'Alph.Sortierung gem. Spalte A
'sheets sichtbar machen
Application.ScreenUpdating = False
For InI = Sheets.Count To 1 Step -1
Sheets(InI).Visible = True
Next InI
Application.ScreenUpdating = True
'Blattname aus Zelle des Blattes
On Error Resume Next
For Each Blatt In ActiveWorkbook.Worksheets
'"Übersicht" ; "Grundformular" ; "ListeHäufigerEintragungen" ; "Übersicht Schießen"
If Blatt.Name "Übersicht" And _
Blatt.Name "Grundformular" And _
Blatt.Name "ListeHäufigerEintragungen" And _
Blatt.Name "Übersicht Schießen" Then
With Blatt
If .Cells(4, 1) "" Then
.Name = .Cells(4, 1) 'zelle A4 (1.Spalte,4.Zeile)
Else
.Name = .CodeName
End If
End With
End If
Next Blatt
Sheets("Übersicht").Visible = True
'Auflistung (in Spalte A) aller Tabellen so wie ihre momentane Reihenfolge im Workbook ist
all = ThisWorkbook.Worksheets.Count
ReDim shArray(5 To all)
On Error Resume Next
For i = 5 To all '5 to all = ab dem Blatt das momentan auf Platz 5 liegt
x = ThisWorkbook.Sheets(i).Name
shArray(i) = x
Next i
For j = LBound(shArray) To UBound(shArray)
Sheets(1).Cells(j + 0, 1) = shArray(j) 'A...ab wohin die Namen in Übersicht geschrieben _
werden j + 1 = 2.Zeile, 1 = 1.Spalte
Next j
'alphab. Sortierung Frontblatt ab A5 - 200
Sheets("Übersicht").Select
Range("A5:A200").Select 'Bereich der aufgezeichneten Sortierung
Selection.Sort Key1:=Range("A5"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'Alph.Sortierung der Tabellen gem. Frontblatt Spalte A
For Each Zelle In Sheets("Übersicht").Range("A5").CurrentRegion.Cells
Sheets(Zelle.Value).Move after:=Sheets(ThisWorkbook.Sheets.Count)
Next
'sheets unsichtbar machen
Application.ScreenUpdating = False
For InI = Sheets.Count To 1 Step -1
Sheets(InI).Visible = False
Next InI
Application.ScreenUpdating = True
Sheets("Übersicht").Select
Range("A5").Select
End Sub
Danke für evtl. Hilfe,
Alex