Dateien alphabetisch in Excel-Datei kopieren

Sub Daten_einlesen2(strPfad As String, AnzDateien As Integer)
Dim strDatnam As String
Dim wb As Workbook
Dim wks As Worksheet
Dim rngEinfüg As Range
Dim I As Integer
Dim j As Integer
Dim FirstBook As Object
Dim x As String
Dim y As String
Dim z As String
Dim zz As String
Dim objOrdner As Object
'Dim AnzDateien As Long
Dim objFSO As Object
Dim Name As String
Dim strSuchMuster As String
Application.DisplayAlerts = False
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
Name = ActiveWorkbook.Name
For Each wks In ThisWorkbook.Sheets
If InStr(VBA.UCase(wks.Name), "GST") > 0 Then wks.Delete
Next
'******* ab hier
j = 0
strDatnam = Dir(strPfad & Application.PathSeparator & "*.csv")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objOrdner = objFSO.GetFolder(strPfad)
Set objOrdner = objFSO.GetFolder(strPfad)
For I = 1 To AnzDateien
Do While Len(strDatnam)
j = j + 1
Set wb = Workbooks.Open(strPfad & "\" & strDatnam)
Set FirstBook = ActiveWorkbook
x = ActiveSheet.Name
zz = ActiveWorkbook.Name
With ThisWorkbook
Workbooks(Name).Activate
y = ActiveSheet.Name
'ActiveWorkbook.Worksheets.Copy After:=.Worksheets(.Worksheets.Count)
Sheets.Add AFTER:=Sheets(Sheets.Count)
ActiveSheet.Name = "GST" & j
z = ActiveSheet.Name
Workbooks(zz).Worksheets(x).Range("A1:Z500").Copy Destination:=Workbooks(Name).Worksheets( _
z).Range("A1:Z500")
End With
wb.Close savechanges:=False
strDatnam = Dir
Loop
Next I
'***** bis hier
Set rngEinfüg = Nothing
Set wb = Nothing
Daten_trennen (AnzDateien)
Call Datum_eintragen
Call Datum_vergleichen
With Application
.ScreenUpdating = False
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
Sheets("Daten").Activate
End Sub