Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1356to1360
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Autofilter speichern anstatt Drucken

Autofilter speichern anstatt Drucken
05.05.2014 10:06:26
Naddl
Hallo,
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

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Autofilter speichern anstatt Drucken
05.05.2014 10:28:14
Tino
Hallo,
wie wäre es die Daten zu kopieren.
in etwa so.
Tabelle1.AutoFilter.Range.Copy Workbooks("Meine Datei.xlsm").Sheets(1).Cells(1, 1)
Gruß Tino

AW: Autofilter speichern anstatt Drucken
05.05.2014 10:49:09
Naddl
Hallo und Danke für deine schnelle Antwort.
Ich habe es versucht indem ich die angezeigten Zellen in eine neue Datei schreiben möchte und dann die alte Datei wieder öffne.
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 = "Pfad"
'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 Cells.Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
ws.SaveAs Pfad & aWerte(i) & ".xlsm"
Workbooks.Open Filename:="Pfad"
'.PrintPreview 'zum testen
'.PrintOut
Next
End With
ws.Range("A1:Q1").AutoFilter Field:=16
'ActiveWorkbook.Save
End Sub

Aber das funktioniert noch nicht ganz, kannst du mir vielleicht sagen wo mein Fehler in meinem Code liegt?

Anzeige
AW: Autofilter speichern anstatt Drucken
05.05.2014 11:11:20
Tino
Hallo,
ich hätte es in etwa so gemacht (nicht getestet)
Dim rng As Range, weiter As VbMsgBoxResult
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
Set rng = .AutoFilter.Range
With Workbooks.Add
rng.Copy .Sheets(1).Cells(1, 1)
.SaveAs Pfad & aWerte(i) & ".xlsm"
.Close False
End With
End With
Next
End With
Tabelle1.AutoFilter.Range.Copy Workbooks("Meine Datei.xlsm").Sheets(1).Cells(1, 1)
Gruß Tino
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige