Skript für den Import von csv Daten in jeweils neue Spalte einer xlsm bzw xlsx Datei

Wert_Zeile1
Wert_Zeile2
...

Wert1;Wert2;Wert...

Wert_Zeile1WertZeile2WertZeile3

Option Explicit
Option Compare Text

Const CsvFolder = "E:\Test\Csv"  

Public Sub CsvImport()
    Dim oFso As Object, oFile As Object
    Dim aTemp As Variant, aText As Variant
    Dim sText As String, sValue As String
    Dim dValue As Double, iColCount As Long, iRowStart As Long, i As Long
    
    Set oFso = CreateObject("Scripting.FileSystemObject")  
    
    ActiveSheet.UsedRange.ClearContents
    
    Application.ScreenUpdating = False
    
    iColCount = 1
    
    For Each oFile In oFso.GetFolder(CsvFolder).Files
        If oFso.GetExtensionName(oFile.Name) Like "csv" Then  
            sText = oFso.OpenTextFile(oFile.Path).ReadAll
            aText = Split(Replace(sText, vbCr, ""), vbLf)  
            
            aTemp = Split(Split(oFso.GetBaseName(oFile.Name), ".")(0), "_")  
            
            Cells(1, iColCount).Value = "Csv-" & aTemp(UBound(aTemp))  
        
            iRowStart = IIf(IsNumeric(aText(0)), 2, 1)
            
            For i = 2 - iRowStart To UBound(aText)
                sValue = aText(i)
                If sValue <> "" Then  
                    If IsNumeric(sValue) Then
                        dValue = CDbl(Replace(sValue, ".", ","))  
                    Else
                        dValue = GetDoubleValue(sValue)
                    End If
                    
                    Cells(iRowStart + i, iColCount).Value = dValue
                End If
            Next
            iColCount = iColCount + 1
        End If
    Next

    ActiveSheet.UsedRange.NumberFormat = "#,##0.00"  
    
    Application.ScreenUpdating = True
End Sub

'Konvertiert Formate wie '15. Mai' oder 'Apr 15' in Zahlenwerte  
Private Function GetDoubleValue(ByVal sValue As String) As Double
    Dim aTemp As Variant, aMonths As Variant
    
    aTemp = Split(sValue)
    
    If UBound(aTemp) = 0 Then
        aTemp = Split(sValue, ".")  
    End If
    
    If UBound(aTemp) = 1 Then
        aMonths = Array("jan", "feb", "mrz", "apr", "mai", "jun", "jul", "aug", "sep", "okt", "nov", "dez")  
        
        With WorksheetFunction
            If Not IsNumeric(aTemp(0)) Then
                GetDoubleValue = CDbl(.Match(Trim(aTemp(0)), aMonths, 0) & "," & aTemp(1))  
            ElseIf Not IsNumeric(aTemp(1)) Then
                GetDoubleValue = CDbl(aTemp(0) & "," & .Match(Trim(aTemp(1)), aMonths, 0))  
            End If
        End With
    End If
End Function