Sub Export2()
Dim fsT As Object, sFilename As Variant, tmpStr As String
Dim lS As Long, lZ As Long, l As Long
Dim SrcRg As Range
sFilename = Application.GetSaveAsFilename("", "CSV File (*.csv), *.csv")
If Selection.Cells.Count > 1 Then
Set SrcRg = Selection
Else
Set SrcRg = ActiveSheet.UsedRange
End If
With SrcRg
For lZ = 1 To .Rows.Count
For lS = 1 To .Columns.Count
tmpStr = tmpStr & """" & .Cells(lZ, lS) & """;"
Next lS
tmpStr = Left(tmpStr, Len(tmpStr) - 1) & vbCrLf
Next lZ
End With
Set fsT = CreateObject("ADODB.Stream")
fsT.Type = 2
fsT.Charset = "utf-8"
fsT.Open
fsT.WriteText tmpStr
fsT.SaveToFile sFilename, 2
Set fsT = Nothing
End Sub
Danke schonmal :)