Code für Einlesen aus ganzen Ordner abändern

Sub einlesen()
With Application
.DecimalSeparator = "."
.ThousandsSeparator = ""
Dim wb As Workbook, wks As Worksheet, wbAktiv As Workbook, wksAktiv As Worksheet
Dim rngZelle As Range
Dim strVerzeichnis As String
Dim Dateiname As Variant, DateinameTXT As String
ChDrive "E"
ChDir "E:\Test\...\Auswertung\"
Dateiname = Application.GetOpenFilename(FileFilter:="CSV (*.csv), *.csv")
If Dateiname = False Then Exit Sub
strVerzeichnis = VBA.CurDir
Set wbAktiv = ActiveWorkbook
Set wksAktiv = ActiveSheet
Set rngZelle = Worksheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Offset(0, 0)
Application.ScreenUpdating = False
VBA.FileCopy Source:=Dateiname, Destination:=Left(Dateiname, Len(Dateiname) - 3) & "txt"  _
_
DateinameTXT = Left(Dateiname, Len(Dateiname) - 3) & "txt"
Application.Workbooks.OpenText Filename:=DateinameTXT, Origin:=xlWindows, _
StartRow:=1, _
DataType:=xlDelimited, ConsecutiveDelimiter:=False, _
Tab:=False, _
Semicolon:=False, _
Comma:=True, _
Space:=False, _
Other:=False
Set wb = ActiveWorkbook
wb.Sheets(1).UsedRange.Copy
rngZelle.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Set rngZelle = rngZelle.Offset(wb.Sheets(1).UsedRange.Rows.Count, 0)
wb.Close savechanges:=False
VBA.Kill (DateinameTXT)
Application.ScreenUpdating = True
ActiveSheet.Copy
fil = Application.GetSaveAsFilename(, FileFilter:="Excel Arbeitsmappe (*.xls),*.xls")
If fil = False Then Exit Sub
ActiveWorkbook.SaveAs Filename:=fil, FileFormat:=xlExcel8
ActiveWorkbook.Close (True)
Worksheets("Tabelle1").Cells.Clear
Range("A1").Select
End With
End Sub