Tabellen sortieren

Sub Blatter_Sortieren() Anzahl = ActiveWorkbook.Worksheets.Count For x = 1 To Anzahl For y = x To Anzahl If Worksheets(y).Name < Worksheets(x).Name Then Worksheets(y).Move Before:=Worksheets(x) End If Next y Next x End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Sub Blatter_Sortieren() Dim anzahl As Integer Dim x As Integer Dim y As Integer anzahl = ActiveWorkbook.Worksheets.Count For x = 2 To anzahl For y = x To anzahl If Worksheets(y).Range("K3") < Worksheets(x).Range("K3") Then Worksheets(y).Move Before:=Worksheets(x) End If Next y Next x End Sub

Hallo
oder hier eine Variante für den alternativen Wert
Option Explicit
Sub Create_Hyperlink_Table_of_Contents()
    'by Ramses
    'Erstellt ein Inhaltsverzeichnis auf alle Tabellen einer
    'Mappe mit Hyperlinks auf die jeweiligen Tabellen
    'und sortiert nach deren Wert in K3
    Dim tarWks As Worksheet
    Dim i As Integer, myRow As Integer, tmpCnt As Integer
    Dim tarWksNewName As String
    'Zieltabelle Namen
    tarWksNewName = "Inhaltsverzeichnis"
    'Blattnamen anpassen
    On Error GoTo myErrorHandler
    Set tarWks = Worksheets(tarWksNewName)
    ErrorResume:
    'Bestehenden Inhalt löschen
    tarWks.Columns(1).ClearContents
    With tarWks
        .Cells(1, 1) = "Inhalt"
        .Cells(1, 2) = "Wert K3"
    End With
    'Erstellen des Inhaltsverzeichnisses
    '**************************
    'Vertikal
    For i = 2 To Worksheets.Count
        If Worksheets(i).Name <> tarWksNewName Then
            With tarWks
                .Cells(i, 1) = Worksheets(i).Name
                .Cells(i, 1).Hyperlinks.Add Anchor:=.Cells(i, 1), Address:="", SubAddress:="'" & Worksheets(i).Name & "'!A1", TextToDisplay:=Worksheets(i).Name
                .Cells(i, 2) = Worksheets(i).Range("K3")
            End With
        End If
    Next i
    'Sortiert das Inhaltsverzeichnis
    'Aufsteigend sortieren
    tarWks.Range("A:B").Sort Key1:=tarWks.Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    'Absteigend sortieren
    'tarWks.Range("A:B").Sort Key1:=tarWks.Range("B1"), Order1:=xldescending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    ErrorExit:
    Exit Sub

    myErrorHandler:
    Debug.Print Err.Number & Err.Description
    Select Case Err.Number
        Case 9 Or -2147352565
            Set tarWks = Worksheets.Add
            With tarWks
                .Name = tarWksNewName
                .Move before:=Worksheets(1)
            End With
            Resume ErrorResume
        Case Else
            MsgBox "Fehler: " & Err.Number & vbCrLf & Err.Description
            Resume ErrorExit
    End Select
End Sub

Gruss Rainer

Hallo
"...Bei diesem VBA tut sich auch nichts. ..."
Du musst halt vorher sagen, dass du keine Ahnung von VBA hast.
Wenn du einen Code hereinstellst, gehen wir davon aus, dass du weisst wo der Code hin soll
Mit "Alt"+"F11" den VB-Editor starten
Rechte Maustaste auf "VBA-Projekt DeineArbeitsmappe.xls"
Modul einfügen
Den Code dann in DIESES Modul reinkopieren
Den Code kannst du starten mit "Extras - Makro - Makro ausführen"
oder
über eine Schaltfläche die du aus der Symbolleiste "Formular" auf deine Tabelle ziehst, oder
Eine Schalftfläche einer Symbolleiste zufügst (Ansicht - Symbolleisten - Anpassen - Kategorie:Makros - Benuzerdefinierte Schalftfläche) und dieser dann mit der rechten Maustaste das Makro zuweist
Gruss Rainer

Beliebteste Forumthreads (12 Monate)

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread