ich habe es mal mit dem Spezialfilter (wie auch hier empfohlen) umgesetzt.
Da funktioniert es (hoffentlich) in allen Versionen.
Code:
Option Explicit
'Kuwer
Sub TestSpezialfilter()
Static Counter As Long
Application.ScreenUpdating = False
Call FilterAus
Select Case Counter
Case 1
Call FehlerSpezialfilter
Case 2
Call EmailSpezialfilter
Case 3
Call FaxSpezialfilter
End Select
If Counter > 2 Then
Counter = 0
Else
Counter = Counter + 1
End If
Application.ScreenUpdating = False
End Sub
Sub FehlerSpezialfilter()
With Worksheets("Filter")
'CriteriaRange wird neu erstellt
.Range("A1:F2") = ""
Worksheets("Tabelle1").Range("A1:F1").Copy .Range("A1")
.Range("A2").Formula = "<>Call"
.Range("C2").Formula = "="
.Range("D2").Formula = "=true"
Worksheets("Fax").Range("A1").CurrentRegion = ""
Worksheets("Tabelle1").Range("A1").CurrentRegion.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=.Range("A1:F2"), _
CopyToRange:=Worksheets("Fax").Range("A1")
End With
End Sub
Sub FilterAus()
With Worksheets("Tabelle1")
If .FilterMode Then
If .AutoFilterMode Then
.AutoFilterMode = False
Else
.ShowAllData
End If
End If
End With
End Sub
Du hattest ja geschrieben, dass sich wohl ab XL2010 etwas geändert haben muss. Weißt du zwischenzeitlich, was geändert wurde? Liegt das eher an der Filterfunktion, die mit den unterschiedlichen Makros angestoßen werden oder eher an den Makros, die von den unterschiedlichen XL-Versionen nicht umgesetezt werden können?
Gruß Günter Jeder Fehler erscheint unglaublich dumm, wenn andere ihn begehen. angebl. von Georg Christoph Lichtenberg (1742-1799)
ich habe es mal mit dem Spezialfilter (wie auch hier empfohlen) umgesetzt.
Da funktioniert es (hoffentlich) in allen Versionen.
Code:
Option Explicit
'Kuwer
Sub TestSpezialfilter()
Static Counter As Long
Application.ScreenUpdating = False
Call FilterAus
Select Case Counter
Case 1
Call FehlerSpezialfilter
Case 2
Call EmailSpezialfilter
Case 3
Call FaxSpezialfilter
End Select
If Counter > 2 Then
Counter = 0
Else
Counter = Counter + 1
End If
Application.ScreenUpdating = False
End Sub
Sub FehlerSpezialfilter()
With Worksheets("Filter")
'CriteriaRange wird neu erstellt
.Range("A1:F2") = ""
Worksheets("Tabelle1").Range("A1:F1").Copy .Range("A1")
.Range("A2").Formula = "<>Call"
.Range("C2").Formula = "="
.Range("D2").Formula = "=true"
Worksheets("Fax").Range("A1").CurrentRegion = ""
Worksheets("Tabelle1").Range("A1").CurrentRegion.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=.Range("A1:F2"), _
CopyToRange:=Worksheets("Fax").Range("A1")
End With
End Sub
Sub FilterAus()
With Worksheets("Tabelle1")
If .FilterMode Then
If .AutoFilterMode Then
.AutoFilterMode = False
Else
.ShowAllData
End If
End If
End With
End Sub
ich habe es mal mit dem Spezialfilter (wie auch hier empfohlen) umgesetzt.
Da funktioniert es (hoffentlich) in allen Versionen.
Code:
Option Explicit
'Kuwer
Sub TestSpezialfilter()
Static Counter As Long
Application.ScreenUpdating = False
Call FilterAus
Select Case Counter
Case 1
Call FehlerSpezialfilter
Case 2
Call EmailSpezialfilter
Case 3
Call FaxSpezialfilter
End Select
If Counter > 2 Then
Counter = 0
Else
Counter = Counter + 1
End If
Application.ScreenUpdating = False
End Sub
Sub FehlerSpezialfilter()
With Worksheets("Filter")
'CriteriaRange wird neu erstellt
.Range("A1:F2") = ""
Worksheets("Tabelle1").Range("A1:F1").Copy .Range("A1")
.Range("A2").Formula = "<>Call"
.Range("C2").Formula = "="
.Range("D2").Formula = "=true"
Worksheets("Fax").Range("A1").CurrentRegion = ""
Worksheets("Tabelle1").Range("A1").CurrentRegion.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=.Range("A1:F2"), _
CopyToRange:=Worksheets("Fax").Range("A1")
End With
End Sub
Sub FilterAus()
With Worksheets("Tabelle1")
If .FilterMode Then
If .AutoFilterMode Then
.AutoFilterMode = False
Else
.ShowAllData
End If
End If
End With
End Sub
Gruß Uwe
Danke
Ich benutze dein Spezialfilter
Ist es auch möglich die Spalten die ich nicht brauche gleichzeitig auszublenden?
Es wären Spalten : H, K, L, O, R, S, T, U, W