Makro CSV erstellen, aber nur bestimmte Spalten

Question

Guten Morgen,
ich habe eine Exceltabelle mit 5 Tabellenblättern. 3 Tabellenblätter sollen per Makro als CSV-Datei abgespeichert werden. Allerdings nicht die komplette Datei, sondern nur:

Tabellenblatt Aktionsplanung_Vol : Spalten A-O
Tabellenblatt Aktionsplanung_Fam: Spalten A-H
Tabellenblatt Aktionsplanung_67: Spalten A-E

Das bisher eingesetzte Makro sieht so aus:

Sub csv_speichern()

Dim strPfad As String

strPfad = "\\192.168.50.9\LogoMate_Transfer\LogoMate\Daten\Manuell\Aktionen\"

'Tabelle Aktionsplanung_Vol speichern
ActiveWorkbook.Worksheets("Aktionsplanung_Vol").SaveAs Filename:=strPfad & "Aktionsplanung_Vol.csv" _
, FileFormat:=xlCSV, CreateBackup:=False, Local:=True

'Tabelle Aktionsplanung_Fam speichern
ActiveWorkbook.Worksheets("Aktionsplanung_Fam").SaveAs Filename:=strPfad & "Aktionsplanung_Fam.csv" _
, FileFormat:=xlCSV, CreateBackup:=False, Local:=True

'Tabelle Aktionsplanung_67 speichern
ActiveWorkbook.Worksheets("Aktionsplanung_67").SaveAs Filename:=strPfad & "Aktionsplanung_67.csv" _
, FileFormat:=xlCSV, CreateBackup:=False, Local:=True

Worksheets("Aktionsplanung_Vol").Select

End Sub

Kann mir einer das Makro umbauen?
Gruß, Colatrinker

Answer 1

Hallo,

das hättest du auch gleich sagen können ;-).

Versuch mal das folgende Makro:

Sub spaltenexport()
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

'Bildschirmaktualiserung ausschalten
Application.ScreenUpdating = False

'Ausgabepfad wird festgelegt
Ausgabepfad = "\\192.168.50.9\LogoMate_Transfer\LogoMate\Daten\Manuell\Aktionen\"

'Trennzeichen wird festgelegt
Trennzeichen = ";"

'Namen der Tabellenblätter die als CSV-ausgegeben werden
arrTabellen = Array("Aktionsplanung_Vol", "Aktionsplanung_Fam", "Aktionsplanung_67")

'letzte Spalte, die in den einzelnen Blättern ausgegeben werden soll, ab Spalte A = 1
arrSpalten = Array(15, 8, 5)

'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 "Export beendet", 64
End Sub

Gruß

M.O.

Answer 2

:-)....toll, jetzt sogar mit Infobox. Vielen Dank, so hab ich mir das vorgestellt.

Dankeschön.
Colatrinker