AW: Aus einer csv mehrere csv erzeugen anhand einer Spalte
30.09.2025 13:10:25
Yal
Hallo Maupard,
ja, es geht vermutlich am besten mit VBA, da es einen Zugriff auf einer Datei gibt, die zuerst ausserhalb von Excel liegt.
Ich habe ChatGPT (die Blume mit schwarzen Hintergrund rechts im Kopfbereich dieser Seite) folgende Frage gestellt:
"Ich habe einen csv-Datei, die ich in Excel laden möchte. Dabei soll jede Datensatz in einem Arbeitsblatt zugeordnet werden. Die Zuordnung erfolgt auf Basis der Information in der erste Spalte der Datensatz, was auch der Name des Arbeitsblatts bildet. Wie lautet der VBA-Code, um das zu realisieren?"
und folgende Antwort bekommen (sogar ein bisschen mehr):
Sub ImportCSVNachSheets()
Dim DateiDialog As FileDialog
Dim DateiPfad As String
Dim Zeile As String
Dim FNr As Integer
Dim Werte As Variant
Dim ws As Worksheet
Dim ZielZeile As Long
Dim BlattName As String
' Datei auswählen
Set DateiDialog = Application.FileDialog(msoFileDialogFilePicker)
With DateiDialog
.Title = "Bitte CSV-Datei auswählen"
.Filters.Clear
.Filters.Add "CSV-Dateien", "*.csv"
If .Show > -1 Then Exit Sub
DateiPfad = .SelectedItems(1)
End With
' Datei öffnen
FNr = FreeFile
Open DateiPfad For Input As #FNr
Application.ScreenUpdating = False
' Zeilenweise lesen
Do While Not EOF(FNr)
Line Input #FNr, Zeile
Werte = Split(Zeile, ";") ' Trennzeichen anpassen falls nötig
BlattName = CStr(Werte(0))
' Ungültige Blattnamen bereinigen (könnte weggelassen werden, wenn klar ist, dass solche Zeichen nicht vorkommen)
BlattName = Replace(BlattName, ":", "_")
BlattName = Replace(BlattName, "\", "_")
BlattName = Replace(BlattName, "/", "_")
BlattName = Replace(BlattName, "?", "_")
BlattName = Replace(BlattName, "*", "_")
BlattName = Replace(BlattName, "[", "_")
BlattName = Replace(BlattName, "]", "_")
' Prüfen, ob Blatt existiert
On Error Resume Next
Set ws = ThisWorkbook.Worksheets(BlattName)
On Error GoTo 0
If ws Is Nothing Then
Set ws = ThisWorkbook.Worksheets.Add
ws.Name = Left(BlattName, 31) ' max. 31 Zeichen
End If
' Erste freie Zeile suchen
ZielZeile = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1
' Werte einfügen
ws.Cells(ZielZeile, 1).Resize(1, UBound(Werte) + 1).Value = Werte
Set ws = Nothing
Loop
Close #FNr
Application.ScreenUpdating = True
MsgBox "Import abgeschlossen!", vbInformation
End Sub
Der Code sieht mMn schlüssig aus. Ich habe ihn nicht getestet (müsste dafür 'ne csv aufbauen, und, und, und, ..).
Es behandelt aber nur die erste Teil der Abfrage. Die zweite Teil, speichern der einzelne Blätter als csv, könnte auf die gleiche Art und Weise entstehen.
Wenn direkt von csv zu csv verarbeitet werden sollte, am besten ChatGPT fragen.
VG
Yal