Sub CSVFile()
Dim CurrCell As Range
Dim CurrTextStr As String
Dim ListSep As String
Dim FeldSep As String
Dim str As String
Const LW = "c:\"
Const Pfad = "c:\X\Y\Desktop\"
Dim FName As Variant
Dim Datumzeitstempel As String
Dim Jetzt As Date
Jetzt = Now()
Datumzeitstempel = Year(Date) & Format(Month(Date), "00") & Format(Day(Date), "00")
Datumzeitstempel = Datumzeitstempel & "" & Format(Hour(Jetzt), "00") & Format(Minute(Jetzt), "00") & Format(Second(Jetzt), "00")
ChDrive LW
ChDir Pfad
FName = Application.GetSaveAsFilename("date_" & Datumzeitstempel & ".csv")
ListSep = ","
If Selection.Cells.Count > 1 Then
Set SrcRg = Selection
Else
Set SrcRg = ActiveSheet.UsedRange
End If
Open FName For Output As #1
For Each CurrRow In SrcRg.Rows
CurrTextStr = ""
FeldSep = IIf(CurrRow.Row < 2, "", """")
For Each CurrCell In CurrRow.Cells
CurrTextStr = CurrTextStr & FeldSep & CurrCell.Value & FeldSep & ListSep
Next
While Right(CurrTextStr, 1) = ListSep
CurrTextStr = Left(CurrTextStr, Len(CurrTextStr) - 1)
Wend
Print #1, CurrTextStr
Next
Close #1
End Sub