VBA - viele CSV Dateien in ein Excel sheet

Sub ImportiereCSVDateien()
    Const CSVPFAD = "E:\csv-dateien"  
    Dim wbTarget As Workbook, wbSource As Workbook, ws As Worksheet, ts As Worksheet
    Set fso = CreateObject("Scripting.Filesystemobject")  
    Set wbTarget = ActiveWorkbook
    Application.DisplayAlerts = False
    'Lösche alle Worksheets bevor wir alle neu anlegen  
    While wbTarget.Worksheets.Count > 1
            wbTarget.Worksheets(1).Delete
    Wend
    wbTarget.Worksheets(1).Name = "Zusammenfassung"  
    wbTarget.Worksheets(1).Range("A:ZZ").Clear  
    For Each f In fso.GetFolder(CSVPFAD).Files
        If LCase(Right(f.Name, 3)) = "csv" Then  
            Workbooks.OpenText Filename:=f.Path
            Set wbSource = ActiveWorkbook
            On Error Resume Next
            Set ws = wbTarget.Worksheets(f.Name)
            If Err <> 0 Then
                Set ws = wbTarget.Worksheets.Add
                ws.Name = f.Name
                ws.Range("A:ZZ").Clear  
            End If
            
            wbSource.Worksheets(1).Range("A:A").Selection.Replace What:=",", Replacement:=";", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False  
            wbSource.Worksheets(1).Range("A:A").Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False  
            
            wbSource.Worksheets(1).Range("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Semicolon:=True, TrailingMinusNumbers:=True  
            wbSource.Worksheets(1).Range("A:ZZ").Copy Destination:=ws.Range("A1")  
            wbSource.Close False
        End If
    Next
    Set ts = wbTarget.Worksheets("Zusammenfassung")  
    Dim curCell As Range
    Set curCell = ts.Range("A1")  
    For i = 1 To wbTarget.Worksheets.Count - 1
        maxRow = wbTarget.Worksheets(i).Range("A1").End(xlDown).Row  
        maxCol = wbTarget.Worksheets(i).Range("A1").End(xlToRight).Column  
        wbTarget.Worksheets(i).Range(wbTarget.Worksheets(i).Cells(1, 1), wbTarget.Worksheets(i).Cells(maxRow, maxCol)).Copy Destination:=curCell
        Zelle = Chr(65 + 2 * i) & 1
        Set curCell = ts.Range(Zelle)
    Next
    Application.DisplayAlerts = True
    Set fso = Nothing
End Sub