Haben Untenstehenden Code im Einsatz aber brauche eine Änderung beim Speichern.
Möchte gerne Activesheet in order Test aber gerne unter den Aktuelle Tabellennamen speichern aber mit Datum und Uhrzeit.
Option Explicit
Sub SaveCSV()
'Quelle: Thomas Ramel
'http://www.office-loesung.de/fpost62938.php#62938
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.Range("A1:B5")
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
mfg
Karel