AW: Excel Datei Filtern und Inhalt als CSV speichern
21.01.2015 13:11:48
Klaus
Hallo Sas,
Kommentare direkt im Code. Ich benutze den Autofilter und schalte ihn am Codeende wieder ab - also nicht wundern, falls du einen eigenen Filter gesetzt hattest.
Option Explicit
Sub FiltereMeier()
Call FilterNachNameCSVDatei("Meier")
'wie du nach Schulz und Müller filterst ist dann klar, oder?
End Sub
Sub FilterNachNameCSVDatei(KundeName As String)
Const SpeicherPfad As String = "U:\herbers" 'anpassen
Const SpeicherAls As String = "KundenFilter" 'anpassen
Const wksQuelle As String = "Tabelle1" 'anpassen
Const FilterSpalte As Long = 1 'in A filtern
Const ersteZeile As Long = 1 'Überschriften in Zeile 1
Dim letzteZeile As Long
Dim wkbOld As Workbook
Dim wkbNew As Workbook
Dim SpeicherName As String
Application.ScreenUpdating = False
'aktuelles Blatt merken
Set wkbOld = ActiveWorkbook
'immer eindeutigen Dateinamen ermitteln mit Datum und Uhrzeit
SpeicherName = KundeName & "_" & Format(Date, "yymmdd") & "_" & Format(Time, "hhmmss") & "_" & _
SpeicherAls
With Sheets(wksQuelle)
'Autofilter setzen, nach Kunde filtern, sichtbare Zellen kopieren
Call DoResetAutofilter(Sheets(.Name), FilterSpalte, FilterSpalte, ersteZeile)
.Cells(ersteZeile, FilterSpalte).AutoFilter Field:=1, Criteria1:=KundeName
letzteZeile = .Cells(.Rows.Count, FilterSpalte).End(xlUp).Row
.Range(.Cells(ersteZeile, 1), .Cells(letzteZeile, 1)).SpecialCells(xlCellTypeVisible).Copy
End With
'neues Workbook erstellen
Workbooks.Add
Set wkbNew = ActiveWorkbook
With wkbNew
'Zwischenablage einfügen, als CSV speichern und schließen
.ActiveSheet.Range("A1").PasteSpecial xlPasteValues
ChDir SpeicherPfad
.SaveAs Filename:=SpeicherPfad & "\" & SpeicherName & ".csv", FileFormat:=xlCSVMSDOS
.Close True
End With
With Sheets(wksQuelle)
'Autofilter wieder abschalten
If .AutoFilterMode Then .Cells.AutoFilter
End With
'Zur Sicherheit: altes Workbook wieder aktivieren, falls ein anderes Fenster vorne ist
wkbOld.Activate
Application.ScreenUpdating = True
End Sub
Sub DoResetAutofilter(wksMySheet As Worksheet, iColFirst As Integer, iColLast As Integer, _
lRowFirst As Long)
'* in case a user used another autofiler, this makro resets the autofilter to where needed.
Dim lRowLast As Long
With wksMySheet
lRowLast = .Cells(.Rows.Count, iColFirst).End(xlUp).Row
If .AutoFilterMode Then .Cells.AutoFilter 'Turns OFF Autofilter, if any
.Range(.Cells(lRowFirst, iColFirst), .Cells(lRowLast, iColLast)).AutoFilter 'Turns ON _
Autofilter on given range
End With
End Sub
Grüße,
Klaus M.vdT.