ich hätte gerne Hilfe für folgendens Problem:
Ich habe bereits eine Lösung gefunden wie man in Excel alle Autofilter nacheinander aufrufen und dann ausdrucken lassen kann.
Das Ziel bei mir soll allerdings sein dass der jeweilige Filter dann in eine neue Datei geschrieben wird.
ich habe das versucht, allerdings werden dann trotzdem alle Daten in die Datei geschrieben mit dem ausgewählten Filter, es sollen aber eigentlich wirklich nur die Daten die im Filter angezeigt werden in die Datei geschrieben werden.
Wenn man den Filter ausdruckt sieht man ja auch nur diese Daten.
Könnt ihr mir irgendwie helfen, ist mein Ziel überhaupt möglich?
Hier seht ihr meinen bisherigen Code:
Sub Datei_B1_FilternUndDrucken()
Dim ws As Worksheet, z As Long, i As Long, aWerte(), weiter As Integer
'Workbooks.Open Filename:="F:\Datenschnittstellen\ATOMIG\Master KAG\Daten\" _
& "Orderimport\swift\Mailsendung\AUTO_B1.xls"
' Sheets("MT304").Activate
Pfad = "C:\Users\"
'activeWorkbook.SaveAs Pfad & FUNKTIONIERTspeichern & ".xlsm"
Set ws = ActiveWorkbook.ActiveSheet
ReDim aWerte(0)
For z = 2 To ws.Cells(ws.Rows.Count, 16).End(xlUp).Row
If fWertInArray(aWerte, ws.Cells(z, 16).Value) = False Then
ReDim Preserve aWerte(UBound(aWerte) + 1)
aWerte(UBound(aWerte)) = ws.Cells(z, 16).Value
End If
Next
With ws
z = .Cells(.Rows.Count, 16).End(xlUp).Row
For i = 1 To UBound(aWerte)
.Range(.Rows(1), .Rows(z)).AutoFilter Field:=16, Criteria1:=aWerte(i)
weiter = MsgBox("Filter '" & aWerte(i) & "' drucken?", vbQuestion + vbYesNoCancel)
If weiter = vbCancel Then Exit For
If weiter = vbYes Then SaveAs Pfad & aWerte(i) & ".xlsm"
'.PrintPreview 'zum testen
'.PrintOut
Next
End With
ws.Range("A1:Q1").AutoFilter Field:=16
'ActiveWorkbook.Save
End Sub
Ich würde mich über schnelle Antworten freuen.Vielen Dank im Voraus