Sub Filtern()
'
' Filtern Makro
'
' Finde die letzte Zeile und Spalte in der Tabelle
Dim letzteZeile As Long, letzteZeile2 As Long, i As Long, ii As Long
Dim letzteSpalte As Long, rngFirst As Range, rnglast As Range, RngArray
'
ActiveSheet.ListObjects("Tabelle1").Range.AutoFilter Field:=22, Criteria1:="=*Zube*"
Dim l As Long
Dim zahl As Long
zahl = 0
For l = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
If Rows(l).Hidden = False Then zahl = zahl + 1
Next
zahl = zahl - 1
ii = zahl
letzteZeile = Cells(Rows.Count, 1).End(xlUp).Row
letzteZeile2 = Cells(Rows.Count, 1).End(xlUp).Row + zahl
letzteSpalte = Cells(1, Columns.Count).End(xlToLeft).Column
ReDim RngArray(1 To zahl, 1 To letzteSpalte)
zahl = 1
For i = 2 To letzteZeile
If Rows(i).Hidden = False Then
For l = 1 To letzteSpalte
RngArray(zahl, l) = Cells(i, l).Value
Next
zahl = zahl + 1
End If
Next
Range("Tabelle1" & "[Suv]").EntireRow.Delete
'RngArray = Range("Tabelle1" & "[Suv]").EntireRow.Value
'rngFirst.Copy
'rngFirst.EntireRow.Delete
ActiveSheet.ListObjects("Tabelle1").Range.AutoFilter Field:=22
letzteZeile = Cells(Rows.Count, 1).End(xlUp).Row
ActiveSheet.Range(Cells(letzteZeile + 1, 1), Cells(letzteZeile + ii, letzteSpalte)) = RngArray
End Sub
Suchst du sowas hier?
|