Mittels VBA Makro Excel Zellen auslesen und diese in eine CSV Datei exportieren

Sub TestRange()
    Dim ws As Worksheet, fd As FileDialog, rngTest As Range, rngExport As Range, fltr As FileDialogFilter
    'Worksheet auf dem die Daten stehen  
    Set ws = Worksheets(1)
    'Zelle die auf Inhalt überprüft werden soll  
    Set rngTest = ws.Range("A1")  
    'Bereich der exportiert wird  
    Set rngExport = ws.Range("A1:D5")  
    If rngTest.Text <> "" Then  
        Set fd = Application.FileDialog(msoFileDialogSaveAs)
        With fd
            .Title = "Wählen sie einen Namen unter der die CSV-Datei gespeichert werden soll"  
            'Filterindex für CSV-Dateien ermitteln  
            For i = 1 To .Filters.Count
                If .Filters(i).Extensions = "*.csv" Then  
                    .FilterIndex = i
                    Exit For
                End If
            Next
            'Wenn OK geklickt wurde starte Export  
            If .Show = True Then
                ExportRangeAsCSV rngExport, ";", .SelectedItems(1)  
            End If
        End With
    End If
End Sub

'Prozedur für den Export eines Ranges in eine CSV-Datei   
Sub ExportRangeAsCSV(ByVal rng As Range, delim As String, filepath As String)
    Dim arr As Variant, line As String, csvContent As String, fso As Object, csvFile As Object
    Set fso = CreateObject("Scripting.FileSystemObject")  
    Set csvFile = fso.OpenTextFile(filepath, 2, True)
    arr = rng.Value
    If IsArray(arr) Then
        For r = 1 To UBound(arr, 1)
            line = ""  
            For c = 1 To UBound(arr, 2)
                If c < UBound(arr, 2) Then
                    line = line & """" & arr(r, c) & """" & delim  
                Else
                    line = line & """" & arr(r, c) & """"  
                End If
            Next
            csvContent = csvContent & line & vbNewLine
        Next
        csvFile.Write (csvContent)
        csvFile.Close
    Else
        MsgBox "Bereich besteht nur aus einer Zelle!", vbExclamation  
    End If
    Set fso = Nothing
    Set csvFile = Nothing
End Sub