Sub ImportiereCSVDateien()

    Dim ordner
    Dim dat
    Set dat = Application.FileDialog(msoFileDialogFolderPicker)
    
    With dat
        .Title = "Netzwerk...."
        .InitialFileName = "I:\cse-val-abteilungen\04_Prüfstände\Antriebsprüfstand Merlin 2\Prüfkollektive\Telematics\" 'oder was auch immer
        If .Show = -1 Then ordner = .SelectedItems(1) 'Zur weiteren verwendung
        MsgBox ordner
   
   End With
   
    CSVPFAD = ordner
    
    

    Dim wbTarget As Workbook, wbSource As Workbook, ws As Worksheet
    
    Set fso = CreateObject("Scripting.Filesystemobject")
    Set wbTarget = ActiveWorkbook
    
   Application.DisplayAlerts = False
    'Lösche alle Worksheets bevor wir alle neu anlegen
    If wbTarget.Worksheets.Count > 1 Then


        For i = 1 To wbTarget.Worksheets.Count - 1

            wbTarget.Worksheets(i).Delete

        Next

    End If

    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").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
    Application.DisplayAlerts = True
    Set fso = Nothing
    
     Sheets("Formeln").Select
    Range("A1").Select
    
    MsgBox "fertig"
    
End Sub