Option Explicit

Public DebugModus As Boolean ' Manuell auf True setzen, wenn du im Einzelschritt arbeitest

Function SpeichereMitVersionskontrolle(pfad As String, basisName As String) As String
Dim i As Integer
Dim dateiPfad As String

i = 1
dateiPfad = pfad & basisName & ".xlsm"

Do While Dir(dateiPfad) > ""
dateiPfad = pfad & basisName & "_" & i & ".xlsm"
i = i + 1
Loop

SpeichereMitVersionskontrolle = dateiPfad
End Function

Function CSV_Import_Direkt() As Worksheet
On Error GoTo Fehler

Dim suchOrdner As String
Dim dateiPfad As String
Dim neueWB As Workbook
Dim zielWS As Worksheet
Dim csvName As String
Dim dateiName As String
Dim fd As FileDialog

suchOrdner = "R:\1\Kontoauszüge\2025\"

' Datei auswählen
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.InitialFileName = suchOrdner
.Title = "Wähle die CSV-Datei aus"
.Filters.Clear
.Filters.Add "CSV-Dateien", "*.csv"
.AllowMultiSelect = False

If .Show > -1 Then
MsgBox "Keine Datei ausgewählt.", vbExclamation
Set fd = Nothing
Exit Function
End If

dateiPfad = .SelectedItems(1)
End With
Set fd = Nothing

Debug.Print "Datei gewählt: " & dateiPfad

dateiName = Dir(dateiPfad)
csvName = Left(dateiName, InStrRev(dateiName, ".") - 1)

' Neue Arbeitsmappe erstellen
Set neueWB = Workbooks.Add
With neueWB.Windows(1)
.Visible = True
.WindowState = xlNormal
.Activate
End With

Set zielWS = neueWB.Sheets(1)
zielWS.Name = "CSV_Tabelle"
zielWS.Activate
zielWS.Range("A1").Select
DoEvents

' Kopfzeilen (außerhalb der Tabelle) einfügen
zielWS.Rows("1:6").Insert Shift:=xlDown
zielWS.Range("E1").Value = "Umsätze VR-Bank"
zielWS.Rows("2:2").RowHeight = 43.5
zielWS.Rows("3:6").RowHeight = 12.75

' CSV einlesen ab Zeile 7
Dim zeile As String, zeilenArray() As String
Dim i As Long, j As Long
Dim fso As Object, ts As Object

Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.OpenTextFile(dateiPfad, 1, True)

i = 7
Do Until ts.AtEndOfStream
zeile = ts.ReadLine
zeilenArray = Split(zeile, ";")
For j = 0 To UBound(zeilenArray)
zielWS.Cells(i, j + 1).Value = zeilenArray(j)
Next j
i = i + 1
Loop
ts.Close

Debug.Print "CSV-Daten bis Zeile: " & i - 1

' Spaltenbreiten manuell setzen
With zielWS
.Columns("A:AQ").ColumnWidth = 12
.Columns("G:G").ColumnWidth = 33
.Columns("K:K").ColumnWidth = 40
End With

' Tabelle ab Zeile 7 erstellen
Dim letzteZeile As Long
letzteZeile = zielWS.Cells(Rows.Count, 1).End(xlUp).Row

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim lo As ListObject
Set lo = zielWS.ListObjects.Add(xlSrcRange, zielWS.Range("A7:AQ" & letzteZeile), , xlYes)
lo.Name = "CSV_Tabelle"
lo.TableStyle = "TableStyleMedium2"

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

' Sichtbereich auf die Tabelle setzen
With zielWS
.Activate
.Range("A7").Select
.Parent.Activate
.Parent.Windows(1).ScrollColumn = 1
.Parent.Windows(1).ScrollRow = 1
End With
DoEvents

Debug.Print "Tabelle erstellt: " & lo.Name & " Bereich: " & lo.Range.Address

' Speichern
Dim speicherPfad As String
speicherPfad = SpeichereMitVersionskontrolle(suchOrdner, csvName)
neueWB.SaveAs Filename:=speicherPfad, FileFormat:=xlOpenXMLWorkbookMacroEnabled
Debug.Print "Datei gespeichert unter: " & speicherPfad

' Jetzt erst Spalten ausblenden
On Error Resume Next
zielWS.Columns("A:D").Hidden = True
zielWS.Columns("F:F").Hidden = True
zielWS.Columns("H:J").Hidden = True
zielWS.Columns("M:M").Hidden = True
zielWS.Columns("P:T").Hidden = True
On Error GoTo 0

' Rückgabe
Set CSV_Import_Direkt = zielWS

' Aufräumen
Set fso = Nothing
Set ts = Nothing
Set lo = Nothing
Set zielWS = Nothing
Set neueWB = Nothing
Exit Function

Fehler:
MsgBox "Fehler beim CSV-Import: " & Err.Description, vbCritical
Set CSV_Import_Direkt = Nothing
End Function


Sub Formatierung_Bankauszuege()
On Error GoTo Fehler

Dim ws As Worksheet
Dim letzteZeile As Long

Set ws = CSV_Import_Direkt()
If ws Is Nothing Then
MsgBox "CSV-Import fehlgeschlagen oder abgebrochen.", vbExclamation
Exit Sub
End If

letzteZeile = ws.Cells.Find("*", , xlFormulas, xlPart, xlByRows, xlPrevious).Row

ws.Columns("G").ColumnWidth = 33
ws.Columns("K").ColumnWidth = 40
ws.Columns("E").ColumnWidth = 11
ws.Columns("U:AQ").ColumnWidth = 11

With ws
.Range("L7:N" & letzteZeile).NumberFormat = "#,##0.00;[Red]-#,##0.00"
.Range("U7:AQ" & letzteZeile).NumberFormat = "#,##0.00;[Red]-#,##0.00"
End With

On Error Resume Next
Application.Run "PERSONAL.XLSB!Kontenplan"
Application.Run "PERSONAL.XLSB!Fenster_teilen"
Application.Run "PERSONAL.XLSB!Formeln_Z_4"
Application.Run "PERSONAL.XLSB!Formeln_Z_5"
Application.Run "PERSONAL.XLSB!Formeln_Z_6"
Application.Run "PERSONAL.XLSB!Formelneintrag"
1800 On Error GoTo 0

ws.Range("AZ1").Value = "Formatiert"

MsgBox "Tabelle erstellt bis Spalte AQ, Formatierung abgeschlossen.", vbInformation
Exit Sub

Fehler:
MsgBox "Fehler in Formatierung_Bankauszuege: " & Err.Description, vbCritical
End Sub

cav-Datei hat nur 18 Spalten. Der oa. Code erstellt eine Int.Tabelle, die mit Spalte O beginnt.