Mein Ziel ist, erstmal die Tabelle durch TB zu filtern dann in neuer Tablle zu kopieren. Danach sollte Filter zurückgesetzt werden und dann nach WB gefiltert werden... Filter zweites Mal klappt leider nicht.
Kann jemand mir helfen?
Vielen Dank im Voraus
Sub Reasoncode30()
Dim fd As Office.FileDialog
Dim last_Row As Long
Dim last_Column As Long
Dim i As Long
Dim j As Long
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.Filters.Clear
.Title = "Bitte Mandant: " & Mandant & " auswählen"
.Filters.Add "Excel Files", "*.xlsx?", 1
.AllowMultiSelect = False
Dim sFile As String
If .Show = True Then
sFile = .SelectedItems(1)
End If
End With
If sFile <> "" Then
Set ext_produkt = Workbooks.Open(sFile)
End If
'Ganze Spalte
last_Row = Cells(Rows.Count, 3).End(xlUp).Row
For i = 3 To last_Row
Cells(i, Worksheets("F01").Range("H1").Column).AutoFilter Worksheets("F01").Range("H1").Column, "TB", Operator:=xlAnd, VisibleDropDown:=True
Cells(i, Worksheets("F01").Range("BO1").Column).AutoFilter Worksheets("F01").Range("BO1").Column, 30, Operator:=xlAnd, VisibleDropDown:=True
Next i
last_Column = Cells(1, Columns.Count).End(xlToLeft).Column
Worksheets.Add
ActiveSheet.Name = "SB und TB Auftrag"
Worksheets("F01").Range("A1:BY" & last_Row).Copy
Worksheets("SB und TB Auftrag").Range("A1:BY" & last_Row).Select
Worksheets("SB und TB Auftrag").Paste
Dim wks As Worksheet
For Each ws In Worksheets
If ws.AutoFilterMode Then
ws.AutoFilterMode = False
End If
Next ws
'For Each wks In ActiveWorkbook.Worksheets
' With wks
' If .FilterMode Then .ShowAllData
' End WithIf ActiveSheet.AutoFilterMode Then
' ActiveSheet.ShowAllData ' zeigt alle Datenstze an, lässt Filter aktiv
' ActiveSheet.UsedRange.AutoFilter ' schaltet Filter ab
'End If
'Next wks
'Worksheets("F01").AutoFilterMode = False
Dim m As Long
If Not Worksheets("F01").AutoFilterMode = True Then
For m = 3 To last_Row
Cells(m, Worksheets("F01").Range("H1").Column).AutoFilter Worksheets("F01").Range("H1").Column, "WB", Operator:=xlAnd, VisibleDropDown:=True
Cells(m, Worksheets("F01").Range("BO1").Column).AutoFilter Worksheets("F01").Range("BO1").Column, 30, Operator:=xlAnd, VisibleDropDown:=True
Next m
Worksheets.Add
ActiveSheet.Name = "WB Auftrag"
Worksheets("F01").Range("A1:BY" & last_Row).Copy
Worksheets("WB Auftrag").Range("A1:BY" & last_Row).Select
Worksheets("WB Auftrag").Paste
End If
End Sub
|