Ich möchte eine CSV-Datei speichern, die bei der Speicherung neben dem vorgegebenen Namen auch das Datum und den Zellinhalt A2 des Tabellenblattes "Aktionsplanung" verwendet.
Die Ursprungsdatei soll aber Excel bleiben.
Folgendes Makro verwende ich derzeit:
Sub CSV_Sicherung()
Dim Ausgabepfad As String
Dim Ausgabedatei As String
Dim lngLetzte As Long
Dim lngSpalte As Long
Dim Zeile As String
Dim VollZeile As String
Dim Trennzeichen As String
Dim arrTabellen
Dim arrSpalten
Dim i As Long
Dim z As Long
'Bildschirmaktualisierung ausschalten
Application.ScreenUpdating = False
'Ausgabepfad wird festgelegt
Ausgabepfad = "G:\Einkauf\Werbung\Aktionsplanung CSV"
'Trennzeichen wird festgelegt
Trennzeichen = ";"
'Namen der Tabellenblätter die als CSV-ausgegeben werden
arrTabellen = Array("Aktionsplanung")
'letzte Spalte, die in den einzelnen Blättern ausgegeben werden soll, ab Spalte A = 1
arrSpalten = Array(19)
'Schleife zum Durchlauf
For i = 0 To 2
'Ausgabepfad und Dateinamen für Ausgabedatei erstellen
Ausgabedatei = Ausgabepfad & arrTabellen(i) & ".csv"
'letzte Zeile des jeweiligen Tabellenblatts ermitteln
lngLetzte = Worksheets(arrTabellen(i)).Cells(Rows.Count, 1).End(xlUp).Row
'Falls Ausgabedatei bereits besteht, wird diese gelöscht
If Dir(Ausgabedatei) <> "" Then Kill (Ausgabedatei)
'Datei Öffen zur Ausgabe
Open Ausgabedatei For Output As #1
For z = 1 To lngLetzte
For lngSpalte = 1 To arrSpalten(i)
Zeile = Trim(Worksheets(arrTabellen(i)).Cells(z, lngSpalte).Text)
Zeile = Replace(Zeile, Trennzeichen, "") 'ggf in Text vorkommendes Trennzeichen wird gelöscht
VollZeile = VollZeile & Zeile & Trennzeichen
Next lngSpalte
'Ausgabe in Datei
VollZeile = Left(VollZeile, Len(VollZeile) - 1) 'Letzten Semicolon abschneiden
Print #1, VollZeile
VollZeile = ""
Next z
Close #1 'Datei schliessen
Next i
'Bildschirmaktualiserung
Application.ScreenUpdating = True
'Abschlussmeldung
MsgBox "Sicherung CSV übertragen", 64
End Sub
