ich habe eine Tabelle in der in Spalte 1 verschiedene Dateinamen aufgelistet sind.("2018_01.csv", "2018_02.csv", "2018_03.csv")
Diese sollen nacheinander geöffnet werden. Dann sollen bestimmte Spalten aus der geöffneten Datei in eine neue Datei geschrieben werden.
Beide Funktionen funktionieren alleine wunderbar. Ich kann in einer csv.-Datei die Spalten auslesen, die ich brauch und ich kann mit der anderen Funktion nacheinander die Dateien öffnen und schließen. (Aber nur wenn die jeweils andere Funktion nicht vorhanden ist) Jetzt ist mein Problem, wie ich die Datei öffne, dann die Funktion ausführe um die Spalten zu kopieren, die Datei schließe und die nächste Datei öffne, etc.
Außerdem haben alle Dateien einen anderen Tabellennamen...evtl anstatt mit Workbook mit Worksheets arbeiten...?
Hoffe ihr könnte mir helfen!
Vielen Dank
Selina
Sub csv_export()
Dim strPfad As String
Dim rFile As Range
Dim blnOpen As Boolean
Dim csvCopy As Variant
strPfad = ThisWorkbook.Path
' ersten Dateinamen auswählen
Set rFile = ThisWorkbook.Sheets("Tabelle1").Range("A1")
' Funktion zum Tabellen öffnen aufrufen
Do While rFile.Value ""
blnOpen = False
If Not WBOpen(rFile.Value) Then
blnOpen = True
Workbooks.Open strPfad & "\" & rFile.Value
End If
' für jede geöffnete Tabelle Funktion Spalten kopieren aufrufen
csvCopy = CopyColoumns(varSpalten)
' Speicherort abfragen
strSpeicherpfad = InputBox("Bitte den Namen der CSV-Datei angeben", "CSV-Export", _
strMappenpfad)
' Neue Mappe als CSV Speichern
ActiveWorkbook.SaveAs strSpeicherpfad, FileFormat:=xlCSV, Local:=True
MsgBox "Export erfolgreich. Datei wurde exportiert nach" & vbNewLine & strSpeicherpfad
Set rFile = rFile.Offset(1, 0)
Loop
End Sub
' *********************************************************' Tabellen öffnen
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
' *********************************************************' Spalten kopieren
Function CopyColoumns(varSpalten As Variant)
Dim intSpalte As Integer
Dim objQuelle As Object
Dim objZiel As Object
Dim strSpeicherpfad As String
Dim strMappenpfad As String
strMappenpfad = ActiveWorkbook.FullName
' Datenquelle festlegen
Set objQuelle = ThisWorkbook.Sheets("2018_01") ' jede Datei hat einen anderen _
Tabellennamen....muss geändert werden
' Neue CSV zum kopieren der Spalte erstellen
Set objZiel = ThisWorkbook.Sheets.Add
varSpalten = Array("N", "B", "C") ' zu speichernde Spalten in Reihenfolge
For intSpalte = 0 To UBound(varSpalten)
' zu speichernde Spalten in neue CSV kopieren
objQuelle.Cells(1, varSpalten(intSpalte)).EntireColoumn.Copy _
Destination:=objZiel.Cells(1, Coloumns.Count).End(xlToLeft).Offset(0, 1)
Next intSpalte
' erste Spalte löschen, weil leer
objZiel.Coloums(1).Delete
' kopierte Daten in neue CSV schreiben
objZiel.Move
End Function