Excell - CSV Dateien aus Ordner in eine Workmap einfügen VBA

Hallo Forum,

ich habe folgendes Problem:
Ich habe eine Menge CSV-Dateien die ich in einer Excelltabelle darstellen will. Für jede Datei soll ein neues Worksheet erstellt werden. Der Name des Worksheets soll der Name der Datei sein.
Ein passendes VBA hab ich hierfür schon, allerdings wird die CSV Datei falsch importiert, ergo werden die Zahlen nicht vernünftig transportiert.
Ein 2. VBA habe ich ebenfalls gefunden bei welchem dies funktioniert da die Kommas durch Punkte ersetzt werden.
Jedoch bekomme ich es nicht hin diese beiden zu verbinden.

Kann mir vielleicht jemand zur Hilfe eilen ?
Hier die Beiden Codes:
1.
Sub ImportiereCSVDateien()
Const CSVPFAD = "E:\csv-dateien"
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
End Sub

2.
Sub ImportiereCSVDateien()
Dim ws As Worksheet, header As Boolean, startRange As Range, curRange As Range, counter As Integer
Const CSVPFAD = "E:\csvdateien"
Set fso = CreateObject("Scripting.Filesystemobject")
Set ws = Worksheets(1)
ws.Range("A:ZZ").Clear
Set startRange = ws.Range("A1")
Set curRange = startRange
Application.DisplayAlerts = False
counter = 1
For Each f In fso.GetFolder(CSVPFAD).Files
If LCase(Right(f.Name, 3)) = "csv" Then
Dim importHeader As Boolean
If counter = 1 Then
header = True
Else
header = False
End If
importCSV f.Path, ";", curRange, header
Set curRange = curRange.End(xlDown).Offset(1, 0)
counter = counter + 1
End If

Next
ws.ListObjects.Add xlSrcRange, ws.Range(startRange, curRange.Offset(-1, curRange.Offset(-1, 0).End(xlToRight).Column - 1))
Application.DisplayAlerts = True
Set fso = Nothing
End Sub

Function importCSV(strPath, delim, ByVal targetRange As Range, ByVal importHeader As Boolean)
Dim intStart As Integer
Set fso = CreateObject("Scripting.FileSystemObject")
Set regex = CreateObject("vbscript.regexp")
patNumber = "^([\d\.,\+\-]+)$"
arrLines = Split(fso.OpenTextFile(strPath, 1).ReadAll(), vbNewLine, -1, vbTextCompare)
Set rngCurrent = targetRange
If importHeader Then
intStart = 0
Else
intStart = 1
End If
For i = intStart To UBound(arrLines)
If arrLines(i) <> "" Then
cols = Split(arrLines(i), delim, -1, vbTextCompare)
For c = 0 To UBound(cols)
rngCurrent.Offset(0, c).ClearFormats
wert = Trim(Replace(cols(c), """", "", 1, -1, vbTextCompare))
' check for Numberformat
regex.Pattern = patNumber
Set matches = regex.Execute(wert)
If matches.Count > 0 Then
wert = Replace(matches(0).Submatches(0), ",", ".", 1, -1, vbTextCompare)
End If
' set value in cell
rngCurrent.Offset(0, c).Value = wert
Next
Set rngCurrent = rngCurrent.Offset(1, 0)
End If
Next
Set fso = Nothing
Set regex = Nothing
End Function

MfG

Sub ImportiereCSVDateien()
Const CSVPFAD = "E:\csv-dateien"  
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
End Sub

Sub ImportiereCSVDateien()
Dim ws As Worksheet, header As Boolean, startRange As Range, curRange As Range, counter As Integer
Const CSVPFAD = "E:\csvdateien"  
Set fso = CreateObject("Scripting.Filesystemobject")  
Set ws = Worksheets(1)
ws.Range("A:ZZ").Clear  
Set startRange = ws.Range("A1")  
Set curRange = startRange
Application.DisplayAlerts = False
counter = 1
For Each f In fso.GetFolder(CSVPFAD).Files
If LCase(Right(f.Name, 3)) = "csv" Then  
Dim importHeader As Boolean
If counter = 1 Then
header = True
Else
header = False
End If
importCSV f.Path, ";", curRange, header  
Set curRange = curRange.End(xlDown).Offset(1, 0)
counter = counter + 1
End If

Next
ws.ListObjects.Add xlSrcRange, ws.Range(startRange, curRange.Offset(-1, curRange.Offset(-1, 0).End(xlToRight).Column - 1))
Application.DisplayAlerts = True
Set fso = Nothing
End Sub

Function importCSV(strPath, delim, ByVal targetRange As Range, ByVal importHeader As Boolean)
Dim intStart As Integer
Set fso = CreateObject("Scripting.FileSystemObject")  
Set regex = CreateObject("vbscript.regexp")  
patNumber = "^([\d\.,\+\-]+)$"  
arrLines = Split(fso.OpenTextFile(strPath, 1).ReadAll(), vbNewLine, -1, vbTextCompare)
Set rngCurrent = targetRange
If importHeader Then
intStart = 0
Else
intStart = 1
End If
For i = intStart To UBound(arrLines)
If arrLines(i) <> "" Then  
cols = Split(arrLines(i), delim, -1, vbTextCompare)
For c = 0 To UBound(cols)
rngCurrent.Offset(0, c).ClearFormats
wert = Trim(Replace(cols(c), """", "", 1, -1, vbTextCompare))  
' check for Numberformat  
regex.Pattern = patNumber
Set matches = regex.Execute(wert)
If matches.Count > 0 Then
wert = Replace(matches(0).Submatches(0), ",", ".", 1, -1, vbTextCompare)  
End If
' set value in cell  
rngCurrent.Offset(0, c).Value = wert
Next
Set rngCurrent = rngCurrent.Offset(1, 0)
End If
Next
Set fso = Nothing
Set regex = Nothing
End Function