Sub SaveCSVUnicode()
Dim Bereich As Object, zeile As Object, Zelle As Object
Dim strTemp As String
Dim strDateiname As String
Dim strTrennzeichen As String
Dim strMappenpfad As String
Dim objFSO, objTextStream
strMappenpfad = ActiveWorkbook.FullName
strMappenpfad = Replace(strMappenpfad, ".xls", ".csv")
strDateiname = InputBox("Wie soll die CSV-Datei heißen (inkl. Pfad)?", "CSV-Export", _
strMappenpfad)
If strDateiname = "" Then Exit Sub
strTrennzeichen = InputBox("Welches Trennzeichen soll verwendet werden?", "CSV-Export", ",")
If strTrennzeichen = "" Then Exit Sub
Set Bereich = Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("B:AI"))
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextStream = objFSO.OpenTextFile(strDateiname, 2, True, -1)
For Each zeile In Bereich.Rows
' Cells(1) entspricht der Spalte B, wenn die Spalte B die erste Spalte ist
If zeile.Cells(1).Value = "e" Then
For Each Zelle In zeile.Cells
If InStr(1, Zelle.Text, strTrennzeichen) > 0 Then
'Zellen, die ein Trennzeichen beinhalten in Anführungsstriche setzen
strTemp = strTemp & """" & CStr(Zelle.Value) & """" & strTrennzeichen
Else
strTemp = strTemp & CStr(Zelle.Value) & strTrennzeichen
End If
Next
If Right(strTemp, 1) = strTrennzeichen Then strTemp = Left(strTemp, Len(strTemp) - 1) & _
_
Chr(10)
objTextStream.Write strTemp
strTemp = ""
End If
Next
objTextStream.Close
Set Bereich = Nothing
MsgBox "Datei wurde exportiert nach" & vbCrLf & strDateiname
End Sub
exportiere ich Daten aus einer Excel-Datei in eine Unicode-TXT-Datei.
Mittlerweile habe ich das Makro schon so angepasst, dass sich der zu exportierende Bereich auf Grund von
Set Bereich = Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("B:AI"))
auf die Spalten B bis AI beschränkt. Gibt es noch eine Möglichkeit, das Ganze weiter einzuschränken? So, dass ich nur bestimmte Spalten auswählen kann? Also z.B. nur B, E bis K und P bis AI zusammen ...
Meine bisherigen Versuche
Set Bereich = Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("B:B;E:K;PAI"))
Set Bereich = Intersect(ActiveSheet.UsedRange, Union(Range("B:B"),Range("E:K"),Range("PAI")))
Set Bereich = Intersect(ActiveSheet.UsedRange, Application.Union(Range("B:B"),Range("E:K"), _
Range("PAI")))
und ich glaube auch noch ein paar andere sind alle fehlgeschlagen :(
Wäre super, wenn mir jemand helfen könnte, wie das ggf. doch klappt ...