CSV ohne Leerzeilen - bekomme es nicht hin ;-)
07.06.2016 13:52:09
Steffen
ich bin neu hier und kein VBA crack, daher meine Frage - konnte mit den anderen Beiträgen nicht wirklich was anfangen:
Ich benutzen diesen Code um Daten aus einem festgelegten Zellbereich in eine CSV zu schreiben - funktioniert auch wunderbar, nur werden die leeren Zeilen des Bereiches auch exportiert.
Das möchte ich verhindern.
Code:
Sub SaveCSV_a()
Dim a As Variant
Dim B() As String
Dim D() As String
Dim Z As Long
Dim S As Byte
Dim R As Long
Dim C As Byte
'Speicherpfad eintragen
Const Path As String = "C:\Test\"
'Dateiname eintragen
Const filename As String = "VIP_Blacklist_Update2"
'Dateiendung anpassen (.txt, .csv oder andere)
Const Extension As String = ".csv"
'Trennzeichen anpassen (Semikolon, Komma oder andere)
Const Separator As String = ","
'Texerkennungszeichen anpassen (kann meist so bleiben)
Const Wrapper As String = ""
'Zu speichernden Bereich eintragen z.B:
'Worksheet("DeinTabellenblatt").UsedRange
'Worksheet("DeinTabellenblatt").Range("C19:E600")
'a = ActiveSheet.UsedRange
a = ActiveSheet.Range("C19:E600")
If Not IsEmpty(a) Then
Z = UBound(a, 1)
S = UBound(a, 2)
ReDim B(S - 1)
ReDim D(Z - 1)
For R = 1 To Z
For C = 1 To S
If InStr(1, a(R, C), Separator) > 0 Then
'Rows whith cells including the Separator
'put in Wrapper
B(C - 1) = Wrapper & a(R, C) & Wrapper
Else
B(C - 1) = a(R, C)
End If
Next C
D(R - 1) = Join(B(), Separator)
Next R
Open Path & filename & Extension For Output As #1
Print #1, Join(D(), vbCrLf)
Close #1
End If
End Sub
Ich Danke Euch für eine Lösung.
VG,
Steffen