Sortieren zurücksetzen

Private Sub Worksheet_Activate() Application.ScreenUpdating = False Unload UserForm8 ActiveSheet.Unprotect Password:="test" Range("A3:B154").Sort Key1:=Range("B3"), Order1:=xlDescending, Key2:=Range("A3") _ , Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:= _ False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _ :=xlSortNormal Range("A3:A154").Columns.AutoFit Range("A2").Select ActiveSheet.Protect Password:="test" Application.ScreenUpdating = True End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Heinz,
vielleicht so.

' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Worksheet_Activate()

  On Error GoTo ErrExit
  Application.ScreenUpdating = False
  Unload UserForm8

  Me.Unprotect Password:="test"

  With Range("C3:C154")
    .Formula = "=ROW()"
    .Value = .Value
    .NumberFormat = ";;;"
  End With

  With Range("A3:C154")
    .Sort Key1:=Range("B3"), _
      Order1:=xlDescending, Key2:=Range("A3"), _
      Order2:=xlAscending, Header:=xlNo, _
      OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
      DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
    .Columns.AutoFit
  End With

  Range("A2").Select
  Me.Protect Password:="test"
  ErrExit:
  Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_Deactivate()

  On Error GoTo ErrExit
  Application.ScreenUpdating = False
  Unload UserForm8

  If Range("C3").NumberFormat = ";;;" Then
    Me.Unprotect Password:="test"

    With Range("A3:C154")
      .Sort Key1:=Range("C3"), _
        Order1:=xlDescending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
      .Columns.AutoFit
      .Columns(3).ClearContents
      .Columns(3).NumberFormat = "General"
    End With

    Range("A2").Select
    Me.Protect Password:="test"
  End If
  ErrExit:
  Application.ScreenUpdating = True
End Sub

Gruß Sepp

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Sortieren zurücksetzen

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread