VBA erweitern

Private Sub CommandButton2_Click()
Dim ablagepfad As String
Dim dateiname As String
Dim pfaderledigt As String
Dim zieldatei As Object
Dim quelle As Object
Dim letztezeile As Long
Dim zeilequelle
Application.ScreenUpdating = False
'die Zieldatei, da wo das Makro ausgeführt wird
Set zieldatei = ThisWorkbook.Sheets("Daten aus CsV")
'Zeile in die eingetragen wird
letztezeile = zieldatei.Cells(Rows.Count, 1).End(xlUp).Row + 1
'pfad für die Ausgangs CSV Dateien
ablagepfad = "I:\Vorlage2\Re_csv"
If Right(ablagepfad, 1)  "\" Then ablagepfad = ablagepfad & "\"
'pfad wohin abgelegt werden soll, also die erledigten
pfaderledigt = "I:\Vorlage2\Re_erl"
If Right(pfaderledigt, 1)  "\" Then pfaderledigt = pfaderledigt & "\"
'erste Datei suchen
dateiname = Dir(ablagepfad & "*.csv")
'wenn keine Datei gefunden, Meldung und Abbruch
If dateiname = "" Then
MsgBox "Keinen DATEN vorhanden.", , "Fehler bei Suche"
End
End If
'falls gefunden, alle durchgehen
Do Until dateiname = ""
'Dateien öffnen
Workbooks.Open ablagepfad & dateiname
Set quelle = ActiveWorkbook
'in Spaltenaufteilen
ActiveSheet.Columns(1).Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=True, Other:=True, OtherChar:= _
"""", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), _
Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
Array(9, 1)), TrailingMinusNumbers:=True
'Anzahl der einzutragendenzeilen ermitteln
zeilequelle = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
'Daten kopieren
quelle.Worksheets(1).Range(quelle.Worksheets(1).Cells(2, 1), _
quelle.Worksheets(1).Cells(zeilequelle, 9)).Copy zieldatei _
.Cells(letztezeile, 1)
'Datum und Zeit des Übertrages rein
zieldatei.Cells(letztezeile, 11) = Now
'Zeile für nächsten Eintrag neu setzen
letztezeile = letztezeile + zeilequelle - 1
'csv schließen
quelle.Close savechanges:=False
'CSV umbenennen und verschieben
Name ablagepfad & dateiname As pfaderledigt & Left(dateiname, Len(dateiname) - 4) _
& " " & Replace(Now, ":", ".") & ".csv"
'nächste CSV suchen
dateiname = Dir
Loop
'Formate noch anpassen, Spaltenbreite an Text anpassen + Format auf Zahl für Spalte B C
zieldatei.Columns("A:K").AutoFit
zieldatei.Columns("B:C").NumberFormat = "0"
With zieldatei.Columns("A:I").Borders
.Weight = xlThin
.LineStyle = xlContinuous
End With
Set zieldatei = Nothing
Set quelle = Nothing
Application.ScreenUpdating = True
End Sub