Schleife / Code verschnellern?

Sub Zelle_auslesen_lang()
'** Dimensionierung der Variablen
'Quelle https://www.excel-inside.de/vba-loesungen/datei/947-daten-aus-geschlossener- _
arbeitsmappe-auslesen
'abgeändert von Tim.Ertl
Dim pfad As String, datei As String, blatt As String, zelle As String, bezug As String
Dim i As Long
Dim r As Long
Dim a As Long
Call ClearCells_lang
r = Selection.Row
a = WorksheetFunction.CountA(Worksheets("Analyse").Range("1:1")) - 2
Worksheets("Analyse").Cells(r, 4).Select
For i = 0 To a
ActiveCell.Offset(0, 1).Range("A1").Select
'** Angaben zur auszulesenden Zelle
pfad = Worksheets("Analyse").Cells(r, 2).Value
datei = Worksheets("Analyse").Cells(r, 3).Value
blatt = Worksheets("Analyse").Cells(1, 5 + i).Value
bezug = Worksheets("Analyse").Cells(2, 5 + i).Value
If blatt = "leer" Then GoTo Sprung
'** Eintragen in Zelle
ActiveCell.Value = GetValue(pfad, datei, blatt, bezug)
Sprung:
Next
End Sub

Public Function GetValue(pfad, datei, blatt, zelle)

'** Daten aus geschlossener Arbeitsmappe auslesen

'Quelle https://www.excel-inside.de/vba-loesungen/datei/947-daten-aus-geschlossener- _

arbeitsmappe-auslesen

'*** Dimensionierung der Variablen

Dim arg As String

'Sicherstellen, dass die Datei vorhanden ist

If Right(pfad, 1)  "\" Then pfad = pfad & "\"

If Dir(pfad & datei) = "" Then

GetValue = "datei Not Found"

Exit Function

End If

'** Das Argument erstellen

arg = "'" & pfad & "[" & datei & "]" & blatt & "'!" & Range(zelle).Range("A1").Address(, ,  _

xlR1C1)

'** Auslesen über Excel4Macro

GetValue = ExecuteExcel4Macro(arg)

End Function

Sub ClearCells_lang()

Dim r As Long

Dim a As Long

Dim zelle As Range

r = Selection.Row

a = WorksheetFunction.CountA(Worksheets("Analyse").Range("1:1")) + 3

For Each zelle In Sheets("Analyse").Range(Cells(r, 5), Cells(r, a))

If zelle.HasFormula = True Then Else zelle.ClearContents

Next zelle

End Sub