Export CSV

Sub CSVDatei_schreiben(fn As String, Verzeichnis As String)
Dim StrPath As String, nFileNr
Dim Zeilen As Integer
Dim Spalten As Integer
Dim FileName As String
Dim Daten As Variant
Dim TS As Range, TZ As Range
Const csvSeparator = ","
On Error GoTo ErrorHandler
StrPath = ActiveWorkbook.Path & "\" & Verzeichnis
If Dir(StrPath, vbDirectory) = "" Then MkDir StrPath
If Right(StrPath, 1)  "\" Then StrPath = StrPath & "\"
FileName = fn & ".fst"
nFileNr = FreeFile
With Worksheets(ActiveSheet.Name)            'es wird die aktive Tabelle benutzt
Zeilen = .Cells(Rows.Count, 1).End(xlUp).Row
Spalten = .Cells(1, Columns.Count).End(xlToLeft).Column
Open StrPath & FileName For Output As #nFileNr
For Each TZ In .Range("A1").Resize(Zeilen, 1)
For Each TS In .Range("A1").Offset(TZ.Row - 1, 0).Resize(1, Spalten)
Daten = Daten & TS.Value & csvSeparator
Next
Print #nFileNr, Daten
Daten = ""
Next
Close #nFileNr
End With
Exit Sub
ErrorHandler:
MsgBox "Fehler " & Err.Number
End Sub

Sub Testschreiben()    'Filename,Verzeichnis
CSVDatei_schreiben "Test1", ""
End Sub