Sub csv_export()
Dim strPfad As String
Dim rFile As Range
Dim strSpeicherpfad As String
Dim wkbQuelle As Workbook
Dim varSpalten As Variant, intSpalte As Integer
Dim wksZiel As Worksheet
strPfad = ThisWorkbook.Path
varSpalten = Array("N", "B", "C")
Set rFile = ThisWorkbook.Sheets("Tabelle1").Range("A1")
Do While rFile <> ""
If Not WBOpen(rFile) Then
Set wkbQuelle = Workbooks.Open(strPfad & "\" & rFile)
End If
Set wkbQuelle = ActiveWorkbook
Set wksZiel = ThisWorkbook.Worksheets.Add
For intSpalte = 0 To UBound(varSpalten)
wkbQuelle.Sheets(1).Columns(varSpalten(intSpalte)).Copy _
Destination:=wksZiel.Cells(1)
Next intSpalte
wkbQuelle.Close False
wksZiel.Move
Set wkbQuelle = ActiveWorkbook
wkbQuelle.Unprotect
strSpeicherpfad = InputBox("Bitte den Namen der CVS-Datei angeben", "CSV-Export", wkbQuelle.Path)
With wksZiel.Parent
.SaveAs strSpeicherpfad, FileFormat:=xlCSV, Local:=True
.Close False
End With
MsgBox "Export erfolgreich. Datei wurde exportiert nach " & vbNewLine & strSpeicherpfad
Set rFile = rFile.Offset(1, 0)
Loop
End Sub
Function WBOpen(ByVal n As String) As Boolean
Dim wb As Workbook
For Each wb In Application.Workbooks
If UCase(wb.Name) = UCase(n) Then
WBOpen = True
Exit Function
End If
Next wb
End Function