Excel VBA code zu Access VBA code

Sub Uebersicht_erstellen()
'true/false vars
Dim dsplalert As Boolean
Dim cal
Dim scrup As Boolean
Dim ev As Boolean
Dim Ask As Boolean
'Ordnervars
Dim dat
Dim ordner
Dim datein
Dim fso
Dim Ac As Worksheet
Set Ac = ActiveSheet
'Copy vars
Dim ExcelFile As Object
Dim wb As Workbook
Dim CopyRange As Range
Dim cell As Range
Dim r As Long
Dim c As Integer
'beschleunigung
With Application
dsplalert = .DisplayAlerts 'fehleranzeige aus
Ask = .AskToUpdateLinks 'Link updates aus
cal = .Calculation ' autoberehnung aus
scrup = .ScreenUpdating
ev = .EnableEvents
.DisplayAlerts = False
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
.AskToUpdateLinks = False
End With
Set dat = Application.FileDialog(msoFileDialogFolderPicker) ' Dialogfenster Ordner wählen
With dat
.Title = "Welche Daten wollen sie zusammenfassen?"
.InitialFileName = "C:" 'Pfad wählen
nochmal: 'sprungmarke
If .Show = -1 Then
ordner = .SelectedItems(1) ' deklarierung var Ordner
Else:
If MsgBox(" Ordner wählen ! " & vbCrLf & "Nochmal ?", vbYesNo) = vbYes Then
GoTo nochmal 'sprung
Else:
GoTo raus 'sprung siehe unten
End If
End If
End With
Set fso = CreateObject("Scripting.filesystemobject")
Set datein = fso.getfolder(ordner)
For Each ExcelFile In datein.Files
If ExcelFile.Name Like "*.xlsx" Then
Set wb = Workbooks.Open(ExcelFile.Path)
Set CopyRange = wb.Sheets("Results Overview").Range("C3,C15,C16,C17,C34,C41,C49,C50,C56,C57, _
_
C133,C139,C145,F145,D152,C159,C161,C162")
r = Ac.Cells(Rows.Count, 2).End(xlUp).Row + 1
'Cells(r, 1) = ExcelFile.Name
c = 2
For Each cc In CopyRange
Ac.Cells(r, c).Value = cc.Value
c = c + 1
Next
wb.Close False
End If
Next
raus:
With Application
.DisplayAlerts = dsplalert
.Calculation = cal
.ScreenUpdating = scrup
.EnableEvents = ev
.AskToUpdateLinks = Ask
End With
End Sub

Sub Sort_Test()
sortform.Show vbModeless
End Sub