Filter (Spaltenname als Tabellenblatt)

Sub KopierenDerListe() Sheets("Mitglieder-Datei").Unprotect Range("a2").Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlToRight)).Select Selection.Copy Sheets.Add After:=ActiveSheet ActiveSheet.Paste Columns("J:J").EntireColumn.AutoFit Columns("L:L").EntireColumn.AutoFit Rows("2:2").Select With ActiveWindow .SplitColumn = 0 .SplitRow = 1 End With ActiveWindow.FreezePanes = True '1. Zeile einfrieren Rows("3:" & Rows.Count).Select With Selection.Interior .PatternThemeColor = xlThemeColorAccent1 .ThemeColor = xlThemeColorDark1 .TintAndShade = 0 .PatternTintAndShade = 0 End With Range("A2").Select ' ActiveSheet.Name = "Name der gefilterten Spalte" Sheets("Mitglieder-Datei").Select Range("A3").Select Selection.Autofilter MsgBox "Achtung" & Chr(13) & "Die gefilterten Daten wurden in ein neues Tabellenblatt kopiert" & "und stehen im nächsten Tabellenblatt zur Verfügung", vbCritical + vbOKOnly Sheets("Mitglieder-Datei").Protect End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Function getautofilter(sSh As String) As String Dim sAf As String sAf = "Kein Filter" With ThisWorkbook.Worksheets(sSh) If .AutoFilter.FilterMode Then If .AutoFilter.Filters.Count > 0 Then sAf = .AutoFilter.Filters(1).Criteria1 End If End If End With getautofilter = af2 End Function

Function getautofilter(sSh As String) As String Dim sAf As String sAf = "Kein Filter" With ThisWorkbook.Worksheets(sSh) If .Autofilter.FilterMode Then If .Autofilter.Filters.Count > 0 Then sAf = .Autofilter.Filters(1).Criteria1 End If End If End With getautofilter = sAf End Function

Hi Steffen,
lösch deine obige Function getautofilter und versuch es hiermit:


Function getautofilter(sSh As String) As String
Dim sAf As String
Dim lloCol As Long
On Error Resume Next
sAf = "Kein Filter"
With ThisWorkbook.Worksheets(sSh)
If .AutoFilter.FilterMode Then
If .AutoFilter.Filters.Count > 0 Then
For lloCol = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
sAf = .AutoFilter.Filters(lloCol).Criteria1
If sAf  "Kein Filter" Then Exit For
Next
End If
End If
End With
On Error GoTo 0
getautofilter = sAf
End Function

Erklärung:
Mit


sAf = .Autofilter.Filters(1).Criteria1

kommt es immer wieder zum Fehler, wenn du den Filter - nicht in Spalte 1 - sondern in jeder anderen Spalte auswählst, denn...


.Filters(1)

...prüft den Filter in Spalte 1!
Da du den Filter aber in einer anderen Spalte ausgewählt hattest, kommt es zu dem Fehler, da in Spalte 1 der Filter gar nicht gesetzt ist.
Da ja niemand weiß, welche Spalte wann ausgewählt wurde, muss man jede Spalte des Autofilters überprüfen.
Deswegen arbeitet mein Code mit For/Next - und mit On Error.
Mein Code "sagt": Wenn es zu einem Fehler kommt, mach mit der nächsten Zeile weiter.
So lange es in...


sAf = .AutoFilter.Filters(lloCol).Criteria1

...zum Fehler kommt, ändert sich der Inhalt von sAf ("Kein Filter") nicht.
Somit wird die If sAf ... Zeile übersprungen, und es geht mit NEXT weiter - so lange, bis DIE SPALTE gefunden wurde, in der der Anwender zuvor die AutoFilter-Auswahl getroffen hatte.
JETZT wird...


sAf = .AutoFilter.Filters(lloCol).Criteria1

....korrekt ausgeführt, sAf erhält die von dir gewünschte Spaltenüberschrift, und mit If sAf "Kein Filter" Then... wird sofort die For/Next-Schleife verlassen.
auch wichtig:
In der Zeile...


For lloCol = ... Cells(1, Columns.Count).End(xlToLeft).Column

...MUSST du die 1 mit der Zeilennummer austauschen, in der sich deine AutoFilter-Zeile befindet.
Hilfts?
Wenn nein, zeig uns eine Datei mit Code mit Daten, in der wir den richtigen Code einbauen können.
Ciao
Thorsten

Beliebteste Forumthreads (12 Monate)

Filter (Spaltenname als Tabellenblatt)

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread