Sub SaveCSV()
'Quelle: Thomas Ramel
<a href="'http://phorum.excelhost.de/read.php?11,74296,74296#msg-74296">'http://phorum.excelhost.de/read.php?11,74296,74296#msg-74296</a>
Dim Bereich As Object
Dim Zeile As Object
Dim Zelle As Object
Dim strTemp As String
Const Pfad As String = "C:\Test\"
Const Dateiname As String = "test"
Const Extension As String = ".CSV"
Const Trennzeichen As String = ";"
Const Kapselzeichen As String = """"
'Hier kann auch ein eigener Range angegeben werden
Set Bereich = ActiveSheet.UsedRange
Open Pfad & Dateiname & Extension For Output As #1
For Each Zeile In Bereich.Rows
For Each Zelle In Zeile.Cells
If InStr(1, Zelle.Text, Trennzeichen) > 0 Then 'angepasst T.Ramel
'Zellen, die ein Trennzeichen beinhalten in Kapselzeichen setzen
strTemp = strTemp & Kapselzeichen & CStr(Zelle.Text) & _
Kapselzeichen & Trennzeichen
Else
strTemp = strTemp & CStr(Zelle.Text) & Trennzeichen
End If
Next
strTemp = Left(strTemp, Len(strTemp) - 1) 'angepasst T.Ramel
Print #1, strTemp
strTemp = ""
Next
Close #1
Set Bereich = Nothing
End Sub
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen