Makro Filtern und Sortieren

[bigrudi1966]

Halo zusammen,

ich habe mir nachfolgendes Makro erstellt um bestimmte Spalten zu Sortieren und zu filtern.

Code:

Sub Filtern_und_Sortieren()
'
' Filtern_und_Sortieren Makro
'
' Tastenkombination: Strg+x
'
    ActiveWorkbook.Worksheets("01.11.2021").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("01.11.2021").AutoFilter.Sort.SortFields.Add Key:= _
        Range("C2:C118"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("01.11.2021").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveSheet.Range("$A$1:$BG$118").AutoFilter Field:=2, Criteria1:="P"
End Sub

Wie müsste der Code geändert werden, dass ich das Makro manuell in jedem Tabellenblatt anwenden kann? Aktuell bekomme ich z.B. im Tabellenblatt "02.11.2021" einen Debug-Fehler. Die Tabellenblätter haben alle ein Datum als Namen.

Ich hoffe ich konnte mein Problem vermitteln.

VG
Rudi

[Kuwer]

Hallo Rudi,

ersetze alle
ActiveWorkbook.Worksheets("01.11.2021")
mit
ActiveSheet

Gruß Uwe

[bigrudi1966]

Danke für die schnelle Hilfe.

Gruß
Rudi

[bigrudi1966]

Hallo Uwe,

ich habe den Code angepasst.

Code:

Sub Filtern_und_Sortieren()
'
' Filtern_und_Sortieren Makro
'
'
    Rows("1:1").Select
    Selection.AutoFilter
    ActiveSheet.AutoFilter.Sort.SortFields.Clear
    ActiveSheet.AutoFilter.Sort.SortFields.Add Key:= _
        Range("C2:C118"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortTextAsNumbers
    With ActiveSheet.AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveSheet.Range("$A$1:$DM$118").AutoFilter Field:=2, Criteria1:="P"
    Columns("C:D").Select
    Selection.EntireColumn.Hidden = True
End Sub

Ich erhalte jedoch einen Debug-Fehler. Die erste Zeile mit Active.Sheet ist gelb hinterlegt.

Wo habe ich da den Fehler gemacht?

VG
Rudi

[Kuwer]

Hallo Rudi,

lass die Zeilen
Rows("1:1").Select
Selection.AutoFilter
weg. Die gab es vorher ja auch nicht.

Gruß Uwe

[bigrudi1966]

Hallo Uwe,

danke für den Hinweis. Manchmal seht man den Wald vor lauter Bäumen nicht. Jetzt klappt es perfekt.

Danke

VG
Rudi

[bigrudi1966]

Hallo Uwe,

bei der Umsetzung hat sich ein Problem ergeben. Die Zellen aus dem Code:

Code:

Range("c2:c118"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _

...also c2:c118 verschieben sich täglich um 3 Spalten. Die nächste Range wäre also f2:f118...dann i2:i118 usw.

Gleiches gilt für:

Code:

 Columns("C:G").Select

...auch hier verschieben sich die Spalten. Die nächsten Spalten wären dann F:G...dann I:J usw. 

Mein Problem ist, dass ich mit externen Daten arbeite, die eine falsche Formatierung aufweisen. Daran arbeite ich gerade. Daher muss ich aktuell die Daten für meine Zwecke anpassen. Das ist natürlich keine optimale Lösung - hilft mir allerdings solange bis die externen Daten passen.

VG
Rudi

[Kuwer]

Hallo Rudi,

vielleicht so?

Code:

Sub Filtern_und_Sortieren()
'
' Filtern_und_Sortieren Makro
'
'
    Dim lngTag As Long

    If IsDate(ActiveSheet.Name) Then
        lngTag = Day(ActiveSheet.Name)
        ActiveSheet.AutoFilter.Sort.SortFields.Clear
        ActiveSheet.AutoFilter.Sort.SortFields.Add Key:= _
            Cells(2, lngTag * 3), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
            :=xlSortTextAsNumbers
        With ActiveSheet.AutoFilter.Sort
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        ActiveSheet.Cells.AutoFilter Field:=2, Criteria1:="P"
        Columns(lngTag * 3).Resize(, 2).Hidden = True
    End If
End Sub

Gruß Uwe

[snb]

Code:

Sub M_snb()
   with activesheet.range("A3:B18").offset(,activesheet.usedrange.columns.count-2)
      .sort .cells(1)
      .autofilter 2, "P"
   end with
End Sub

[bigrudi1966]

Hallo zusammen,

ich bin immer wieder beeindruckt wie schnell und lösungsorientiert hier im Forum geantwortet wird.

Danke vielmals für die schnelle und kompetente Hilfe.

VG
Rudi